Everyone!
I'm working on macros which should select cdrBitmapShape and save it as a separate file.
I've already found out how to search and select such an object, but I've run into a problem of saving it.
I don't get how should I save the chosen image, it is quite unclear from the docs.
As I understand from here I should somehow assign to the Document variable the current selection Item and export it.
Here is the test file
How can I do that?
Sub Findall_bit_map()
' Recorded 03.02.2020
'frmFileConverter.Start
'Dim d As Document
Dim retval As Long
Dim opt As New StructExportOptions
opt.AntiAliasingType = cdrNormalAntiAliasing
opt.ImageType = cdrRGBColorImage
opt.ResolutionX = 600
opt.ResolutionY = 600
Dim pal As New StructPaletteOptions
pal.PaletteType = cdrPaletteOptimized
pal.NumColors = 16
pal.DitherType = cdrDitherNone
Dim Filter As ExportFilter
Set OrigSelection = ActivePage.ActiveLayer.Shapes.All
For Each shpCheck In OrigSelection
re = shpCheck.Type
If shpCheck.Type = cdrBitmapShape Then
retval = MsgBox("BITMAP", vbOKCancel, "Easy Message")
shpCheck.AddToSelection
Set Filter = Document.ExportBitmap("D:\some.jpg", cdrJPEG)
If Filter.ShowDialog() Then
Filter.Finish
Else
MsgBox "Export canceled"
End If
End If
Next shpCheck
retval = MsgBox("Click OK if you agree.", vbOKCancel, "Easy Message")
'ActivePage.Shapes.FindShapes(Query:="@type='BitmapShape'")
If retval = vbOK Then
MsgBox "You clicked OK.", vbOK, "Affirmative"
End If
End Sub
I don't know were was the bug, but here is the working version.
Sub Findall_bit_map_snip()
Dim retval As Long
Dim doc As Document
Dim pal As New StructPaletteOptions
pal.PaletteType = cdrPaletteOptimized
pal.ColorSensitive = True
pal.NumColors = 300000000
pal.DitherType = cdrDitherNone
Dim Filter As ExportFilter
Set OrigSelection = ActivePage.ActiveLayer.Shapes.All
For Each shpCheck In OrigSelection
Set doc = ActiveDocument
doc.ClearSelection
re = shpCheck.Type
If shpCheck.Type = cdrBitmapShape Then
retval = MsgBox("BITMAP", vbOKCancel, "Easy Message")
shpCheck.AddToSelection
Set Filter = doc.ExportBitmap("D:\some.jpg", cdrJPEG, cdrSelection, , , , 600, 600, cdrNoAntiAliasing, , False, , , , pal)
Filter.Finish
End If
Next shpCheck
End Sub