CorelDraw 中的 VBA 宏。导出当前选择答案

【问题标题】：VBA Macros in CorelDraw. Export current selectionCorelDraw 中的 VBA 宏。导出当前选择
【发布时间】：2020-02-03 17:24:25
【问题描述】：

大家！

我正在处理应该选择 cdrBitmapShape 并将其另存为单独文件的宏。

我已经知道如何搜索和选择这样的对象，但是我遇到了保存它的问题。

我不知道应该如何保存所选图像，文档中并不清楚。

据here 了解，我应该以某种方式将当前选择项分配给 Document 变量并将其导出。

Here是测试文件

我该怎么做？

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

【问题讨论】：

标签： vba coreldraw

【解决方案1】：

我不知道是错误，但这是工作版本。

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

【讨论】：