Export all bitmaps from multi-page CDR file

Hi.

Try this. I originally made it for myself, to export all shapes, but modified it to only select bitmap shapes and export to tiff. I haven't tested it with my modifications. You may have to adjust the .opt options as you see fit.

-John

Sub ExportEachShape()
    Dim p As Page
    Dim opt As New StructExportOptions
    Dim s As Shape
    Dim i As Integer, j As Integer
    Dim x#, y#
    Dim filePath As String
   
    '#########################################################'
    '## export all shapes on every page as a tif - by John '##
    '#########################################################'
   
    filePath = "D:\All Graphics\__temp\" ' set your file path here formatted as shown
   
    j = 1
    For Each p In ActiveDocument.Pages
        p.Activate
        For i = 1 To ActivePage.FindShapes(, cdrBitmapShape)
            'If ActivePage.Shapes(i).Type = cdrBitmapShape Then 'optional - uncomment if needed
            ActivePage.Shapes(i).CreateSelection
            ActivePage.Shapes(i).GetPosition x, y
            ActivePage.Shapes(i).AlignToPageCenter cdrAlignHCenter
            ActivePage.Shapes(i).AlignToPageCenter cdrAlignVCenter
           
            'change your jpeg export options here.
            opt.AntiAliasingType = cdrNormalAntiAliasing
            opt.Imagetype = cdrRGBColorImage
            opt.Overwrite = True
            opt.ResolutionX = 72
            opt.ResolutionY = 72
            opt.SizeX = opt.ResolutionX * ActivePage.Shapes(i).SizeWidth
            opt.SizeY = opt.ResolutionY * ActivePage.Shapes(i).SizeHeight

            ActiveDocument.export filePath & j & ".jpg", cdrTIFF, cdrSelection, opt
            ActivePage.Shapes(i).SetPosition x, y
            j = j + 1
            ' end if ' end optional - uncomment if needed
         Next i
    Next p
End Sub