Excel VBA将图像另存为eps或其他矢量文件

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

ActiveWindow.Zoom = 400

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

如果您确实需要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

---

代码刚刚经过测试。

尝试将其导出为pdf。在此之后，Pdf可以作为矢量导入。例如，在CorelDRAW中……我会尝试Irfanview，因为它支持多种格式，并且可以通过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