Selection_Export_JPEG.bas 825 B

12345678910111213141516171819202122232425
  1. ' 指定导出分辨率,其他质量油画按F1查看文档
  2. Dim opt As New StructExportOptions
  3. opt.ResolutionX = 72
  4. opt.ResolutionY = 72
  5. ' 实用小脚本: 选择遍历多个物件对象,按序号导出 JPEG
  6. ActiveDocument.Unit = cdrCentimeter
  7. Dim d As Document
  8. Set d = ActiveDocument
  9. cnt = 1
  10. Dim sh As Shape, shs As Shapes
  11. Set shs = ActiveSelection.Shapes
  12. For Each sh In shs
  13. ActiveDocument.ClearSelection
  14. sh.CreateSelection
  15. MsgBox "选择物件尺寸: " & sh.SizeWidth & "x" & sh.SizeHeight
  16. Size = Str(Int(sh.SizeWidth + 0.5)) + "x" + Str(Int(sh.SizeHeight + 0.5))
  17. f = "R:\www\" + Str(cnt) + "_尺寸" + Size + ".jpg"
  18. ' 可以把获得的尺寸取整数,写到文件名中,或者把尺寸信息写到图片中
  19. d.Export f, cdrJPEG, cdrSelection, opt
  20. cnt = cnt + 1
  21. Next sh