corelvba/UI/PhotoForm.frm

Private Sub UserForm_Initialize()
    On Error Resume Next
    ComboBox1.AddItem "灰度"
    ComboBox1.AddItem "CMYK颜色"
    ComboBox1.AddItem "RGB颜色"
    ComboBox1.AddItem "黑白"
    
    ComboBox2.AddItem "300", 0
    ComboBox2.AddItem "450", 1
    ComboBox2.AddItem "600", 2
    ComboBox2.AddItem "150", 3
End Sub

Private Sub CovPhotos_Click()
    On Error Resume Next
    ActiveDocument.BeginCommandGroup
    Dim Color As String
    Dim a, b As Boolean
    Dim i, dpi As Integer
    
    a = True: b = True
    If ABox1.value = False Then a = False
    If BBox2.value = False Then b = False
    
    dpi = CInt(ComboBox2.text)
    
    Select Case ComboBox1.text
      Case Is = "灰度"
       Color = cdrGrayscaleImage
      Case Is = "CMYK颜色"
       Color = cdrCMYKColorImage
      Case Is = "RGB颜色"
       Color = cdrRGBColorImage
      Case Is = "黑白"
       Color = cdrBlackAndWhiteImage
    End Select
    
    Dim s As Shapes
    Set s = ActiveSelection.Shapes
    If s Is Nothing Then
        MsgBox "请先选中一个形状!"
        Exit Sub
    Else
        For i = 1 To s.Count
        Set s(i) = ActiveShape.ConvertToBitmapEx(Color, False, a, dpi, cdrNormalAntiAliasing, True, False, 95)
        Next i
    End If
    ActiveDocument.EndCommandGroup
End Sub

Private Sub Export_JPEG_Click()
    On Error Resume Next
    Dim d As Document
    Set d = ActiveDocument
    Dim sh As Shape, shs As Shapes
    Dim Color As String
    Set shs = ActiveSelection.Shapes
    
    dpi = CInt(ComboBox2.text)
    Select Case ComboBox1.text
    
    Case Is = "灰度"
      Color = cdrGrayscaleImage
    Case Is = "CMYK颜色"
      Color = cdrCMYKColorImage
    Case Is = "RGB颜色"
      Color = cdrRGBColorImage
    Case Is = "黑白"
      Color = cdrBlackAndWhiteImage
    End Select

    '// 导出图片精度设置，设置颜色模式
    Dim opt As New StructExportOptions
    opt.ResolutionX = dpi
    opt.ResolutionY = dpi
    opt.ImageType = Color
    
    '// 批处理导出图片
    For Each sh In shs
        ActiveDocument.ClearSelection
        sh.CreateSelection

        ' 导出图片 JPEG格式
        f = d.FilePath & "Link_" & sh.StaticID & ".jpg"
        d.Export f, cdrJPEG, cdrSelection, opt
    Next sh
End Sub