Export_JPEG_Link.bas 963 B

1234567891011121314151617181920212223242526272829303132333435363738
  1. Private Sub Export_JPEG_Link_Click()
  2. ActiveDocument.Unit = cdrCentimeter
  3. Dim d As Document
  4. Set d = ActiveDocument
  5. cnt = 1
  6. Dim sh As Shape, shs As Shapes
  7. Set shs = ActiveSelection.Shapes
  8. ' 导出图片精度设置,还可以设置颜色模式
  9. Dim opt As New StructExportOptions
  10. opt.ResolutionX = 300
  11. opt.ResolutionY = 300
  12. ' 导入图片链接设置
  13. Dim impflt As ImportFilter
  14. Dim impopt As New StructImportOptions
  15. With impopt
  16. .Mode = cdrImportFull
  17. .LinkBitmapExternally = True
  18. End With
  19. ' 批处理图片
  20. For Each sh In shs
  21. ActiveDocument.ClearSelection
  22. sh.CreateSelection
  23. ' 导出图片
  24. f = d.FilePath & "Link_" & cnt & ".jpg"
  25. d.Export f, cdrJPEG, cdrSelection, opt
  26. ' 导入图片链接
  27. Set impflt = ActiveLayer.ImportEx(f, cdrTIFF, impopt)
  28. impflt.Finish
  29. cnt = cnt + 1
  30. Next sh
  31. End Sub