VBA сохранить изображения как EPS или другой векторный файл

Question

Мне нужно сохранить некоторые графики в папку в виде векторного типа (например, eps). В настоящее время я масштабирую и сохраняю как png, но это не оптимальное решение, и вставка .emf или .eps возвращает мне ошибку. Ниже код

ActiveWindow.Zoom = 400

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

Answer 1

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

Если вам действительно нужен формат EPS и у вас установлен Corel, им также можно управлять из Excel VBA через COM 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

Код имеет только что был протестирован.