时间戳

首页 > 解决方案 > VBA 将图像保存为 eps 或其他矢量文件

excel - VBA 将图像保存为 eps 或其他矢量文件

问题描述

我需要将一些图形作为矢量类型（例如 eps）保存到文件夹中。我目前正在缩放并保存为 png，但这不是最佳解决方案，插入 .emf 或 .eps 会返回错误。代码下方

ActiveWindow.Zoom = 400

       ActiveChart.Export fileName:="folder\" & shp.TopLeftCell.Offset(-2, 0).Value & ".png", FilterName:="png"

标签： excelvba

解决方案

Sub testExportChartVector()
 Dim ch As Chart
   Set ch = ActiveChart
   ch.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ThisWorkbook.path & "\textChart.pdf"
End Sub

如果你真的需要 EPS 格式并且你已经安装了 Corel，它也可以通过它的 COM VBA 从 Excel VBA 进行操作，就像在下面的代码中一样：

Sub testExportChartEPS()
 Dim ch As Chart, strPDF As String
   strPDF = ThisWorkbook.path & "\textChart.pdf"
   Set ch = ActiveChart
   ch.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=strPDF
   '____________________________________________________________________

   'Using Corel to transform pdf in eps, if strictly EPS needed:
   'Necessary a reference to "Corel - CorelDRAW xx Type Library"
   Dim cor As CorelDRAW.Application, d As CorelDRAW.Document, sh As CorelDRAW.Shape
   Dim Opt As New CorelDRAW.StructExportOptions, p As CorelDRAW.page
   Set cor = CreateObject("CorelDRAW.Application")
     Set d = cor.createDocument
     Set p = d.Pages(1)
     p.ActiveLayer.Import strPDF
     Set sh = cor.ActiveShape
     With Opt
        .Overwrite = True
        .SizeX = sh.SizeWidth
        .SizeY = sh.SizeHeight
     End With

     d.Export left(strPDF, Len(strPDF) - 3) & ".eps", 1289, 1, Opt, Nothing
     sh.Delete

     Set cor = Nothing: Set d = Nothing: Set p = Nothing
     Set sh = Nothing: Set Opt = Nothing: Set Opt = Nothing
End Sub

代码刚刚经过测试。

推荐阅读