当你将图表复制到剪贴板时，Excel会添加很多不同的剪贴板格式。从2011版（Application.Build >= 13426）开始，这现在包括“image/svg+xml”。
所以我们所要做的就是在剪贴板上找到那个格式，然后把它保存到一个文件里。结果证明这相当烦人。

Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GetClipboardFormatName Lib "user32" _
    Alias "GetClipboardFormatNameW" _
    (ByVal wFormat As Long, _
    ByVal lpString As LongPtr, _
    ByVal nMaxCount As Integer) As Integer
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long

Private Declare PtrSafe Function GlobalUnlock Lib "Kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "Kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalSize Lib "Kernel32" (ByVal hMem As LongPtr) As LongPtr

Private Declare PtrSafe Function CreateFile Lib "Kernel32" _
    Alias "CreateFileA" (ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    ByVal lpSecurityAttributes As LongPtr, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As LongPtr) As LongPtr

Private Declare PtrSafe Function WriteFile Lib "Kernel32" _
    (ByVal hFile As LongPtr, _
    ByVal lpBuffer As LongPtr, _
    ByVal nNumberOfBytesToWrite As Long, _
    ByRef lpNumberOfBytesWritten As Long, _
    ByVal lpOverlapped As LongPtr) As Long

Private Declare PtrSafe Function CloseHandle Lib "Kernel32" (ByVal hObject As LongPtr) As Long

Sub SaveClipboard(formatName As String, filename As String)
    Dim fmtName As String
    Dim fmt As Long
    Dim length As Long
    Dim wrote As Long
    Dim data As LongPtr
    Dim fileHandle As LongPtr
    Dim content As LongPtr
    Dim ret As Long
    
    If OpenClipboard(ActiveWindow.hwnd) = 0 Then
        Exit Sub
    End If
    
    fmt = 0
    Do
        fmt = EnumClipboardFormats(fmt)
        If fmt = 0 Then Exit Do
        
        fmtName = String$(255, vbNullChar)
        length = GetClipboardFormatName(fmt, StrPtr(fmtName), 255)
        If length <> 0 And Left(fmtName, length) = formatName Then
            data = GetClipboardData(fmt)
            
            length = CLng(GlobalSize(data))
            content = GlobalLock(data)

            ' use win32 api file handling to avoid copying buffers
            fileHandle = CreateFile(filename, &H120089 Or &H120116, 0, 0, 2, 0, 0)
            ret = WriteFile(fileHandle, content, length, wrote, 0)
            CloseHandle fileHandle
            
            GlobalUnlock data
            Exit Do
        End If
    Loop

    CloseClipboard
    
    If fmt = 0 Then
        MsgBox "Did not find clipboard format " & formatName
        Exit Sub
    End If

End Sub

然后只需复制图表并保存svg;

shape.Copy
SaveClipboard "image/svg+xml", "C:\temp\output.svg"

如果你不需要.svg，那么.emf是另一种矢量格式。它不能直接从Excel工作，但它可以使用一个“助手”PowerPoint应用程序工作：

Sub ExportChartToEMF(ByVal ch As Chart, ByVal filePath As String)
    Const methodName As String = "ExportChartToEMF"
    Const ppShapeFormatEMF As Long = 5
    '
    If ch Is Nothing Then Err.Raise 91, methodName, "Chart not set"
    '
    Dim pp As Object
    Dim slide As Object
    Dim errNumber As Long
    '
    Set pp = CreateObject("PowerPoint.Application")
    With pp.Presentations.Add(msoFalse) 'False so it's not Visible
        Set slide = .Slides.AddSlide(.Slides.Count + 1, .Designs(1).SlideMaster.CustomLayouts(1))
    End With
    '
    ch.Parent.Copy
    On Error Resume Next
    slide.Shapes.Paste.Export filePath, ppShapeFormatEMF
    errNumber = Err.Number
    On Error GoTo 0
    '
    pp.Quit
    If Err.Number <> 0 Then Err.Raise Err.Number, methodName, "Error while exporting to file"
End Sub

您可以像这样使用它：

ExportChartToEMF ActiveChart, "[FolderPath]\[FileName].emf"

如果你真的需要.svg，那么不幸的是，该功能没有暴露给VBA，尽管它可以通过保存为图片对话框（右键单击图表形状）在Excel和PowerPoint中手动工作。
简而言之，您无法完全自动将图表导出为.svg文件，除非您使用中间格式（如.emf或.pdf）或通过另保存为图片对话框手动保存为.svg。

以矢量格式导出：

如果您的主要问题是以某种矢量格式导出图表，我建议您只导出为PDF，因为这非常简单：

Set curChart = objChrt.Chart
objChrt.ExportAsFixedFormat xlTypePDF, "YourChart"

PDF现在包含矢量图形形式的图表，并且PDF是广泛支持的格式，可用于进一步处理。
如果你真的需要把图表转换成.svg，你可以从命令行（因此很容易自动化）使用开源软件Inkscape或者我想的那样：/。

转换为SVG：

不幸的是，Inkscape转换似乎对我不起作用，所以我用开源pdf渲染工具包Poppler实现了它。
此库提供命令行实用程序 pdftocairo，将在以下解决方案中使用：

Sub ExportChartToSVG()
    Dim MyChart As ChartObject
    Set MyChart = Tabelle1.ChartObjects("Chart 1")
    
    Dim fileName As String
    fileName = "TestExport"

    Dim pathStr As String
    pathStr = ThisWorkbook.Path
    
    ' Export chart as .pdf
    MyChart.Chart.ExportAsFixedFormat Type:=xlTypePDF, _
                                      FileName:=pathStr & "\" & fileName
   
    ' Convert .pdf file to .svg
    Dim ret As Double
    ret = Shell("cmd.exe /k cd /d """ & pathStr & """ & " & _
          "pdftocairo -svg -f 1 -l 1 " & fileName & ".pdf", vbHide)
End Sub

请注意，生成的.svg文件中的文本是不可选择的，并且该文件比手动导出生成的文件大（在我的测试中为241 KB vs. 88 KB）。该文件绝对是无限分辨率的，所以不是偶尔会看到的嵌入在.svg文件中的奇怪位图，但会带来另一个小问题：
不幸的是ExportAsFixedFormat方法创建了一个PDF“页面”，其中图形在页面上的位置取决于工作表上的位置。不幸的是，.svg转换保持了这种“页面”格式。我不得不了解，摆脱这个问题并不像我最初想象的那么简单，因为excel不支持自定义页面大小，因此将图表导出为。没有白色边框的pdf看起来几乎是不可能的，看看这个有约束但未解决的question（编辑：我解决了它在下面的部分，也张贴了我的方法作为答案的问题）。我尝试了几种方法，他们甚至没有想到在这个链接的问题，仍然没有设法得到它正确地完成只使用Excel，这可能是可能的，取决于您的打印机驱动程序，但我不会那样做...

导出到没有白色条的干净SVG：

最简单的解决方法是使用Word将图表正确导出为.pdf格式：

Sub ExportChartToSVG()
    Dim MyWorksheet As Worksheet
    Set MyWorksheet = Tabelle1
    
    Dim MyChart As ChartObject
    Set MyChart = MyWorksheet.ChartObjects(1)
    
    Dim fileName  As String
    fileName = "TestExport"
    
    Dim pathStr As String
    pathStr = ThisWorkbook.Path
    
    'Creating a new Word Document
    'this is necessary because Excel doesn't support custom pagesizes
    'when exporting as pdf and therefore unavoidably creates white borders around the
    'chart when exporting
    Dim wdApp As Object
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = False
    
    Dim wdDoc As Object
    Set wdDoc = wdApp.Documents.Add
    
    MyChart.Copy
    wdDoc.Range.Paste
    
    Dim shp As Object
    Set shp = wdDoc.Shapes(1)
    
    With wdDoc.PageSetup
        .LeftMargin = 0
        .RightMargin = 0
        .TopMargin = 0
        .BottomMargin = 0
        .PageWidth = shp.Width
        .PageHeight = shp.Height
    End With
    shp.Top = 0
    shp.Left = 0
    
    wdDoc.saveas2 fileName:=pathStr & "\" & fileName, FileFormat:=17  '(wdExportFormatPDF)
    wdApp.Quit 0 '(wdDoNotSaveChanges)
    Set wdApp = Nothing
    Set wdDoc = Nothing
    Set shp = Nothing

    ' Convert .pdf file to .svg
    Dim ret As Double
    ret = Shell("cmd.exe /k cd /d """ & pathStr & """ & " & "pdftocairo -svg -f 1 -l 1 " & fileName & ".pdf", vbHide)
End Sub

生成的.pdf和.svg看起来与手动导出的.svg完全相同，只是.pdf具有可选文本。.pdf文件仍保留在文件夹中。如果需要，以后可以通过VBA代码轻松删除它...
如果使用此方法导出大量图表，我强烈建议将其移到一个类中，并让该类保存Word应用程序的一个示例，这样它就不会不断地重新打开和关闭Word。它还有一个额外的好处，即可以使要导出的实际代码非常简洁明了。

导出为干净SVG的基于类的方法：

导出的代码变得非常简单：

Sub ExportChartToSVG()
    Dim MyWorksheet As Worksheet
    Set MyWorksheet = Tabelle1
    
    Dim MyChart As ChartObject
    Set MyChart = MyWorksheet.ChartObjects(1)
    
    Dim fileName  As String
    fileName = "TestExport"
    
    Dim filePath As String
    filePath = ThisWorkbook.Path & Application.PathSeparator
    
    Dim oShapeExporter As cShapeExporter
    Set oShapeExporter = New cShapeExporter
    
    ' Export as many shapes as you want here, before destroying oShapeExporter
    ' cShapeExporter can export objets of types Shape, ChartObject or ChartArea
    oShapeExporter.ExportShapeAsPDF MyChart, filePath, fileName

    Set oShapeExporter = Nothing
End Sub

名为cShapeExporter的类模块的代码：

Option Explicit

Dim wdApp As Object
Dim wdDoc As Object

Private Sub Class_Initialize()
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = False

    Set wdDoc = wdApp.Documents.Add
    
    ' Setting margins to 0 so we have no white borders!
    ' If you want, you can set custom white borders for the exported PDF here
    With wdDoc.PageSetup
        .LeftMargin = 0
        .RightMargin = 0
        .TopMargin = 0
        .BottomMargin = 0
    End With
End Sub

Private Sub Class_Terminate()
    ' Important: Close Word instance as the object is destroyed.
    wdApp.Quit 0 '(0 = wdDoNotSaveChanges)
    Set wdApp = Nothing
    Set wdDoc = Nothing
End Sub

Public Sub ExportShapeAsPDF(xlShp As Object, _
                            filePath As String, _
             Optional ByVal fileName As String = "")
    ' Defining which objects can be exported, maybe others are also supported,
    ' they just need to support all the methods and have all the properties used
    ' in this sub
    If TypeName(xlShp) = "ChartObject" Or _
       TypeName(xlShp) = "Shape" Or _
       TypeName(xlShp) = "ChartArea" Then
        'fine
    Else
        MsgBox "Exporting Objects of type " & TypeName(xlShp) & _
               " not supported, sorry."
        Exit Sub
    End If
    
    xlShp.Copy
    wdDoc.Range.Paste
    
    Dim wdShp As Object
    Set wdShp = wdDoc.Shapes(1)

    With wdDoc.PageSetup
        .PageWidth = wdShp.Width
        .PageHeight = wdShp.Height
    End With

    wdShp.Top = 0
    wdShp.Left = 0
    
    ' Export as .pdf
    wdDoc.saveas2 fileName:=filePath & fileName, _
                  FileFormat:=17 '(17 = wdExportFormatPDF)

    wdShp.Delete
End Sub

安装Poppler实用程序：

我假设你在这里使用的是Windows，在Linux上获得Poppler是微不足道的...
所以在Windows上，我建议使用chocolatey包管理器来安装chocolatey。要安装chocolatey，你可以按照these instructions来安装（需要〈5分钟）。
当你有chocolatey，你可以安装Poppler与简单的命令

choco install poppler

现在就可以运行我提出的将.pdf转换为. svg的代码了。
如果您喜欢以不同的方式安装Poppler，here介绍了各种选项，但我想添加一些关于其中一些方法的说明：
1.下载二进制文件对我不起作用，运行该实用程序总是会导致错误。
1.通过Anaconda（conda install -c conda-forge poppler）安装对我来说也不起作用，安装失败了。
1.通过Windows子系统安装Linux确实有效，实用程序也有效，但是如果你还没有安装wsl，包括一个发行版，你将不得不下载并安装几百MB的ob数据，这可能是矫枉过正。
1.如果你已经安装了MiKTeX，这个实用程序应该是包括在内的（在我的例子中也是如此）。我试着从我的MiKTeX安装中安装这个实用程序，不知何故它不起作用。

2023更新

这个问题似乎在Excel Version 2302 Build 16.0.16130.20186）64位中得到了修复，它在2021年以来发布的一个版本中得到了修复。不幸的是，我在release notes/archive中找不到提到这个修复的地方。
现在，它按照documentation：

With ThisWorkbook.Worksheets("Sheet1")
    .ChartObjects("Chart 1").Chart.Export FileName:="path\name.svg", _
                                          FilterName:="SVG"
End With

为了便于以后参考，我将保留下面的bug的原始解决方案。但是，即使您正在使用Excel的某个bug版本，我也建议使用this more elegant workaround by Jeremy Lakeman。

旧解决方案

不使用任何外部应用程序仅使用Excel和VBA导出到.SVG

这是一个hacky的烂摊子，但它的工作。至少现在...
首先，我将解释它是如何工作的，存在哪些必须克服的问题，以及它们是如何解决的。如果你对技术细节不感兴趣，你可以跳到简单使用指南一节。
"这是什么意思"
代码尝试只使用手动导出方法。这有几个问题，第一个是Chart.Export方法中的另一个bug。Chart.Export Interactive:=Trueis supposed to打开了所需的对话框，但这不起作用。通过利用一些快捷方式，可以使用SendKeys "+{F10}"和SendKeys "g"非常可靠地打开导出窗口。第一个障碍是，但麻烦才刚刚开始！
事实证明，打开一个模态对话框会停止整个应用程序中所有代码的执行。即使在打开对话框之前调用了另一个应用程序示例中的代码，我们如何保持它在那里运行，并返回完成打开对话框？这听起来不可能，因为VBA是严格的单线程...
事实证明，单线程并没有那么严格。解决方案称为Application.OnTime，它在未来的预定时间启动一个过程。该过程必须在Excel.Application的另一个示例中运行，因为Application.OnTime仅在应用程序处于特定模式时才启动过程（就绪、复制、剪切或查找），并且运行VBA代码或打开模式对话框。因此，在打开对话框之前，需要创建Excel应用程序的后台示例，VBA代码插入其中，并计划在对话框打开后立即在后台示例中开始运行。注意：由于代码是自动插入到后台示例中的，因此需要启用“信任对VBA工程对象模型的访问”。
我们现在如何只使用VBA代码来处理Windows对话框呢？我设法通过EnumChildWindows获得了对话框的所有窗口和控件句柄，并使用这些信息将文本插入到“FileName”组合框中。由于此输入框也接受路径，剩下的唯一问题是在FileFormat组合框中选择“.svg”，然后单击“保存”按钮。不幸的是，我没有“我们无法避免在这里使用SendKeys。
使用Windows API函数更改组合框中的选择相对容易，但问题是实际上要让它注册更改。它似乎在对话框中更改，但当单击“保存”时，它仍然保存为. png。我花了几个小时在Spy++中监视手动更改期间发送的消息，但我无法用VBA重现它们。正因为如此，必须再次为SendKeys，以更改文件格式并按下“保存”。
SendKeys在这个解决方案中被非常小心地使用，包括各种安全检查，并且在每次使用之前将目标窗口拉到前面，但是如果在宏运行的同时与PC交互，那么它从来不是100%安全的。
因为这个方法需要一个类似于here和here的后台应用示例，所以我为ShapeExporter对象实现了一个类，创建对象会打开后台应用，销毁对象会关闭它。

简单使用指南

以下过程将指定工作表中的所有ChartObjects导出到保存工作簿的文件夹中。

Sub ExportEmbeddedChartToSVG()
    Dim MyWorksheet As Worksheet
    Set MyWorksheet = Application.Worksheets("MyWorksheet")
    
    'Creating the ShapeExporter object
    Dim oShapeExporter As cShapeExporter
    Set oShapeExporter = New cShapeExporter
    
    'Export as many shapes as you want here, before destroying oShapeExporter
    Dim oChart As ChartObject
    For Each oChart In MyWorksheet.ChartObjects
        'the .ExportShapeAsSVG method of the object takes three arguments:
        '1. The Chart or Shape to be exported
        '2. The target filename
        '3. The target path
        oShapeExporter.ExportShapeAsSVG oChart, oChart.Name, ThisWorkbook.Path
    Next oChart
    
    'When the object goes out of scope, its terminate procedure is automatically called
    'and the background app is closed
    Set oShapeExporter = Nothing
End Sub

要使代码工作，您必须首先：

1.信任对VBA工程对象模型的访问（有关原因，请参见宏的详细说明）
1.创建一个类模块，将其重命名为“cShapeExporter“，并将以下代码粘贴到其中：

'Class for automatic exporting in SVG-Format
'Initial author: Guido Witt-Dörring, 09.12.2020
'https://stackoverflow.com/a/65212838/12287457

'Note:
'When objects created from this class are not properly destroyed, an invisible 
'background instance of Excel will keep running on your computer. In this 
'case, you can just close it via the Task Manager.
'For example, this will happen when your code hits an 'End' statement, which 
'immediately stops all code execution, or when an unhandled error forces 
'you to stop code execution manually while an instance of this class exists.

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As Boolean
    Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Boolean
    Private Declare PtrSafe Function IsIconic Lib "user32" (ByVal hWnd As LongPtr) As Boolean
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
    Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Boolean
    Private Declare Function IsWindowVisible Lib "User32" (ByVal hWnd As Long) As Boolean
    Private Declare Function IsIconic Lib "User32" Alias "IsIconic" (ByVal hWnd As long) As boolean
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Private NewXlAppInstance As Excel.Application
Private xlWbInOtherInstance As Workbook
    
Private Sub Class_Initialize()
    Set NewXlAppInstance = New Excel.Application
    Set xlWbInOtherInstance = NewXlAppInstance.Workbooks.Add
    
    NewXlAppInstance.Visible = False
    
    On Error Resume Next
    xlWbInOtherInstance.VBProject.References.AddFromFile "scrrun.dll"
    xlWbInOtherInstance.VBProject.References.AddFromFile "FM20.dll"
    On Error GoTo 0
    
    Dim VbaModuleForOtherInstance As VBComponent
    Set VbaModuleForOtherInstance = xlWbInOtherInstance.VBProject.VBComponents.Add(vbext_ct_StdModule)
    
    VbaModuleForOtherInstance.CodeModule.AddFromString CreateCodeForOtherXlInstance
End Sub

Private Sub Class_Terminate()
    NewXlAppInstance.DisplayAlerts = False
    NewXlAppInstance.Quit
    Set xlWbInOtherInstance = Nothing
    Set NewXlAppInstance = Nothing
End Sub

Public Sub ExportShapeAsSVG(xlShp As Object, FileName As String, FilePath As String)
    'Check if path exists:
    If Not ExistsPath(FilePath) Then
        If vbYes = MsgBox("Warning, you are trying to export a file to a path that doesn't exist! Continue exporting to default path? " & vbNewLine & "Klick no to resume macro without exporting or cancel to debug.", vbYesNoCancel, "Warning") Then
            FilePath = ""
        ElseIf vbNo Then
            Exit Sub
        ElseIf vbCancel Then
            Error 76
        End If
    End If
    If TypeName(xlShp) = "ChartObject" Or TypeName(xlShp) = "Shape" Or TypeName(xlShp) = "Chart" Or TypeName(xlShp) = "ChartArea" Then
        'fine
    Else
        MsgBox "Exporting Objects of type " & TypeName(xlShp) & " not supported, sorry."
        Exit Sub
    End If
    
    If TypeName(xlShp) = "ChartArea" Then Set xlShp = xlShp.Parent
    
retry:
    SetForegroundWindow FindWindow("XLMAIN", ThisWorkbook.Name & " - Excel")
    
    If Not Application.Visible Then 'Interestingly, API function "IsWindowVisible(Application.hWnd)" doesn't work here! (maybe because of multi monitor setup?)
        MsgBox "The workbook must be visible for the svg-export to proceed! It must be at least in window mode!"
        Application.WindowState = xlNormal
        Application.Visible = True
        Sleep 100
        GoTo retry
    End If
    
    If IsIconic(Application.hWnd) Then 'Interestingly "Application.WindowState = xlMinimized" doesn't work here!"
        MsgBox "The workbook can't be minimized for the svg-export to proceed! It must be at least in window mode!"
        Application.WindowState = xlNormal
        Sleep 100
        GoTo retry
    End If
    
    'check if background instance still exists and start support proc
    On Error GoTo errHand
    NewXlAppInstance.Run "ScheduleSvgExportHelperProcess", Application.hWnd, ThisWorkbook.Name, FileName, FilePath
    On Error GoTo 0
    
    Sleep 100

    xlShp.Activate
    
    SetForegroundWindow FindWindow("XLMAIN", ThisWorkbook.Name & " - Excel")
    SendKeys "+{F10}"
    DoEvents
    SendKeys "g"
    DoEvents
    Exit Sub
errHand:
    MsgBox "Error in ShapeExporter Object. No more shapes can be exported."
    Err.Raise Err.Number
End Sub

Public Function ExistsPath(ByVal FilePath As String) As Boolean
    Dim oFso As Object
    Dim oFolder As Object
    
    Set oFso = CreateObject("Scripting.FileSystemObject")
    'Setting the Folder of the Filepath
    On Error GoTo PathNotFound
    Set oFolder = oFso.GetFolder(Left(Replace(FilePath & "\", "\\", "\"), Len(Replace(FilePath & "\", "\\", "\")) - 1))
    On Error GoTo 0
    
    ExistsPath = True
    Exit Function
    
PathNotFound:
    ExistsPath = False
End Function

Private Function CreateCodeForOtherXlInstance() As String
    Dim s As String
    s = s & "Option Explicit" & vbCrLf
    s = s & "" & vbCrLf
    s = s & "#If VBA7 Then" & vbCrLf
    s = s & "    Public Declare PtrSafe Sub Sleep Lib ""kernel32"" (ByVal dwMilliseconds As Long)" & vbCrLf
    s = s & "    Private Declare PtrSafe Function GetForegroundWindow Lib ""user32"" () As LongPtr" & vbCrLf
    s = s & "    Private Declare PtrSafe Function GetWindowText Lib ""user32"" Alias ""GetWindowTextA"" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long" & vbCrLf
    s = s & "    Private Declare PtrSafe Function FindWindow Lib ""user32"" Alias ""FindWindowA"" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr" & vbCrLf
    s = s & "    Private Declare PtrSafe Function SetForegroundWindow Lib ""user32"" (ByVal hWnd As LongPtr) As Boolean" & vbCrLf
    s = s & "    Private Declare PtrSafe Function SendMessage Lib ""user32"" Alias ""SendMessageA"" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr" & vbCrLf
    s = s & "    Private Declare PtrSafe Function GetClassName Lib ""user32"" Alias ""GetClassNameA"" (ByVal hWnd As LongPtr, ByVal lpStr As String, ByVal nMaxCount As Long) As Long" & vbCrLf
    s = s & "    Private Declare PtrSafe Function EnumChildWindows Lib ""user32"" (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Boolean" & vbCrLf
    s = s & "    Private Declare PtrSafe Function GetWindowTextLength Lib ""user32"" Alias ""GetWindowTextLengthA"" (ByVal hWnd As LongPtr) As Long" & vbCrLf
    s = s & "    Private Declare PtrSafe Function GetWindowLongPtr Lib ""user32"" Alias ""GetWindowLongPtrA"" (ByVal hWnd As LongPtr, ByVal nindex As Long) As LongPtr" & vbCrLf
    s = s & "#Else" & vbCrLf
    s = s & "    Public Declare Sub Sleep Lib ""kernel32"" (ByVal lngMilliSeconds As Long)" & vbCrLf
    s = s & "    Private Declare Function GetForegroundWindow Lib ""user32"" () As Long" & vbCrLf
    s = s & "    Private Declare Function GetWindowText Lib ""user32"" Alias ""GetWindowTextA"" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long" & vbCrLf
    s = s & "    Private Declare Function FindWindow Lib ""user32"" Alias ""FindWindowA"" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long" & vbCrLf
    s = s & "    Private Declare Function SetForegroundWindow Lib ""user32"" (ByVal hwnd As Long) As Boolean" & vbCrLf
    s = s & "    Private Declare Function SendMessage Lib ""user32"" Alias ""SendMessageA"" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long" & vbCrLf
    s = s & "    Private Declare Function GetClassName Lib ""user32"" Alias ""GetClassNameA"" (ByVal hwnd As Long, ByVal lpStr As String, ByVal nMaxCount As Long) As Long" & vbCrLf
    s = s & "    Private Declare Function EnumChildWindows Lib ""User32"" (ByVal hwndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As boolean" & vbCrLf
    s = s & "    Private Declare Function GetWindowTextLength Lib ""User32"" Alias ""GetWindowTextLengthA"" (ByVal hwnd As Long) As Long" & vbCrLf
    s = s & "    Private Declare Function GetWindowLongPtr Lib ""User32"" Alias ""GetWindowLongPtrA"" (ByVal hwnd As Long, ByVal nindex As Long) As Long" & vbCrLf
    s = s & "#End If" & vbCrLf
    s = s & "" & vbCrLf
    s = s & "Private Const GWL_ID = -12" & vbCrLf
    s = s & "" & vbCrLf
    s = s & "Private Const WM_SETTEXT = &HC" & vbCrLf
    s = s & "" & vbCrLf
    s = s & "'Const for this Application:" & vbCrLf
    s = s & "Private Const dc_Hwnd = 1" & vbCrLf
    s = s & "Private Const dc_ClassName = 2" & vbCrLf
    s = s & "Private Const dc_CtlID = 3" & vbCrLf
    s = s & "Private Const dc_CtlText = 4" & vbCrLf
    s = s & "" & vbCrLf
    s = s & "Private Const Window_Search_Timeout As Single = 5#" & vbCrLf
    s = s & "Public ChildWindowsPropDict As Object" & vbCrLf
    s = s & "" & vbCrLf
    s = s & "#If VBA7 Then" & vbCrLf
    s = s & "    Private Function GetCtlText(ByVal hctl As LongPtr) As String" & vbCrLf
    s = s & "#Else" & vbCrLf
    s = s & "    Private Function GetCtlText(ByVal hctl As Long) As String" & vbCrLf
    s = s & "#End If" & vbCrLf
    s = s & "    Dim ControlText As String" & vbCrLf
    s = s & " On Error GoTo WindowTextTooLarge" & vbCrLf
    s = s & "    ControlText = Space(GetWindowTextLength(hctl) + 1)" & vbCrLf
    s = s & "    GetWindowText hctl, ControlText, Len(ControlText)" & vbCrLf
    s = s & "    GetCtlText = ControlText 'Controls Text" & vbCrLf
    s = s & "    Exit Function" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "WindowTextTooLarge:" & vbCrLf
    s = s & "    ControlText = Space(256)" & vbCrLf
    s = s & "    On Error GoTo -1" & vbCrLf
    s = s & "    GetWindowText hctl, ControlText, Len(ControlText)" & vbCrLf
    s = s & "    GetCtlText = ControlText  'Controls Text" & vbCrLf
    s = s & "End Function" & vbCrLf
    s = s & "" & vbCrLf
    s = s & "#If VBA7 Then" & vbCrLf
    s = s & "    Private Function EnumChildProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long" & vbCrLf
    s = s & "#Else" & vbCrLf
    s = s & "    Private Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Long" & vbCrLf
    s = s & "#End If" & vbCrLf
    s = s & "    Dim ClassName As String" & vbCrLf
    s = s & "    Dim subCtlProp(1 To 4) As Variant" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    subCtlProp(dc_Hwnd) = hWnd 'Controls Handle" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    ClassName = Space(256)" & vbCrLf
    s = s & "    GetClassName hWnd, ClassName, Len(ClassName)" & vbCrLf
    s = s & "    subCtlProp(dc_ClassName) = Trim(CStr(ClassName)) 'Controls ClassName" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    subCtlProp(dc_CtlID) = GetWindowLongPtr(hWnd, GWL_ID) 'Controls ID" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    subCtlProp(dc_CtlText) = GetCtlText(hWnd)   'Controls Text 'Doesn't always work for some reason..." & vbCrLf
    s = s & "                                                '(sometimes returns """" when Spy++ finds a string)" & vbCrLf
    s = s & "    ChildWindowsPropDict.Add key:=CStr(hWnd), Item:=subCtlProp" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    'continue to enumerate (0 would stop it)" & vbCrLf
    s = s & "    EnumChildProc = 1" & vbCrLf
    s = s & "End Function" & vbCrLf
    s = s & "" & vbCrLf
    s = s & "#If VBA7 Then" & vbCrLf
    s = s & "    Private Sub WriteChildWindowsPropDict(hWnd As LongPtr)" & vbCrLf
    s = s & "#Else" & vbCrLf
    s = s & "    Private Sub WriteChildWindowsPropDict(hWnd As Long)" & vbCrLf
    s = s & "#End If" & vbCrLf
    s = s & "    On Error Resume Next" & vbCrLf
    s = s & "    Set ChildWindowsPropDict = Nothing" & vbCrLf
    s = s & "    On Error GoTo 0" & vbCrLf
    s = s & "    Set ChildWindowsPropDict = CreateObject(""Scripting.Dictionary"")" & vbCrLf
    s = s & "    EnumChildWindows hWnd, AddressOf EnumChildProc, ByVal 0&" & vbCrLf
    s = s & "End Sub" & vbCrLf
    s = s & "" & vbCrLf
    s = s & "Private Function ExistsFileInPath(ByVal FileName As String, ByVal FilePath As String, Optional warn As Boolean = False) As Boolean" & vbCrLf
    s = s & "    Dim oFso As Object" & vbCrLf
    s = s & "    Dim oFile As Object" & vbCrLf
    s = s & "    Dim oFolder As Object" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    Set oFso = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
    s = s & "    'Setting the Folder of the Filepath" & vbCrLf
    s = s & "    On Error GoTo PathNotFound" & vbCrLf
    s = s & "    Set oFolder = oFso.GetFolder(Left(Replace(FilePath & ""\"", ""\\"", ""\""), Len(Replace(FilePath & ""\"", ""\\"", ""\"")) - 1))" & vbCrLf
    s = s & "    On Error GoTo 0" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    'Writing all Filenames of the Files in the Folder to flStr" & vbCrLf
    s = s & "    For Each oFile In oFolder.Files" & vbCrLf
    s = s & "        If oFile.Name = FileName Then" & vbCrLf
    s = s & "            ExistsFileInPath = True" & vbCrLf
    s = s & "            Exit Function" & vbCrLf
    s = s & "        End If" & vbCrLf
    s = s & "    Next oFile" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    ExistsFileInPath = False" & vbCrLf
    s = s & "    Exit Function" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "PathNotFound:" & vbCrLf
    s = s & "    If warn Then MsgBox ""The path "" & Chr(10) & FilePath & Chr(10) & "" was not found by the function ExistsFileInPath."" & Chr(10) & ""Returning FALSE""" & vbCrLf
    s = s & "    ExistsFileInPath = False" & vbCrLf
    s = s & "End Function" & vbCrLf
    s = s & "" & vbCrLf
    s = s & "#If VBA7 Then" & vbCrLf
    s = s & "    Public Sub ScheduleSvgExportHelperProcess(ByVal Wb1hwnd As LongPtr, ByVal Wb1Name As String, ByVal SvgFileName As String, ByVal SvgFilePath As String)" & vbCrLf
    s = s & "#Else" & vbCrLf
    s = s & "    Public Sub ScheduleSvgExportHelperProcess(ByVal Wb1hwnd As Long, ByVal Wb1Name As String, ByVal SvgFileName As String, ByVal SvgFilePath As String)" & vbCrLf
    s = s & "#End If" & vbCrLf
    s = s & "    If Not Wb1hwnd = FindWindow(""XLMAIN"", Wb1Name & "" - Excel"") Then" & vbCrLf
    s = s & "        MsgBox ""Error finding Wb1hwnd - something unforseen happened!""" & vbCrLf
    s = s & "        GoTo badExit" & vbCrLf
    s = s & "    End If" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    Application.OnTime Now + TimeValue(""00:00:02""), ""'SvgExportHelperProcess """""" & CStr(Wb1hwnd) & """""", """""" & Wb1Name & """""", """""" & SvgFileName _" & vbCrLf
    s = s & "                        & """""", """""" & SvgFilePath & """"""'"", Now + TimeValue(""00:00:015"")" & vbCrLf
    s = s & "    Exit Sub" & vbCrLf
    s = s & "badExit:" & vbCrLf
    s = s & "    MsgBox ""Shutting down background instance of excel.""" & vbCrLf
    s = s & "    Application.DisplayAlerts = False" & vbCrLf
    s = s & "    Application.Quit" & vbCrLf
    s = s & "End Sub" & vbCrLf
    s = s & "" & vbCrLf
    s = s & "Public Sub SvgExportHelperProcess(ByVal Wb1hwndStr As String, ByVal Wb1Name As String, ByVal SvgFileName As String, ByVal SvgFilePath As String)" & vbCrLf
    s = s & "    #If VBA7 And Win64 Then" & vbCrLf
    s = s & "        Dim Wb1hwnd As LongPtr" & vbCrLf
    s = s & "        Wb1hwnd = CLngPtr(Wb1hwndStr)" & vbCrLf
    s = s & "        Dim dlgHwnd As LongPtr" & vbCrLf
    s = s & "        Dim tempHctrl As LongPtr" & vbCrLf
    s = s & "    #Else" & vbCrLf
    s = s & "        Dim Wb1hwnd As LongPtr" & vbCrLf
    s = s & "        Wb1hwnd = CLng(Wb1hwndStr)" & vbCrLf
    s = s & "        Dim dlgHwnd As Long" & vbCrLf
    s = s & "        Dim tempHctrl As Long" & vbCrLf
    s = s & "    #End If" & vbCrLf
    s = s & "    Dim i As Long" & vbCrLf
    s = s & "    Dim stopTime As Single" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    'Find dialog window handle" & vbCrLf
    s = s & "    stopTime = Timer() + Window_Search_Timeout" & vbCrLf
    s = s & "    Do" & vbCrLf
    s = s & "        dlgHwnd = 0" & vbCrLf
    s = s & "        Sleep 15" & vbCrLf
    s = s & "        DoEvents" & vbCrLf
    s = s & "        SetForegroundWindow Wb1hwnd  'FindWindow(""XLMAIN"", Wb1Name & "" - Excel"")" & vbCrLf
    s = s & "        Sleep 150" & vbCrLf
    s = s & "        dlgHwnd = FindWindow(""#32770"", vbNullString)" & vbCrLf
    s = s & "    Loop Until Timer() > stopTime Or dlgHwnd <> 0" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    If dlgHwnd = 0 Then" & vbCrLf
    s = s & "        MsgBox ""Couldn't find dialog window handle!""" & vbCrLf
    s = s & "        GoTo errHand" & vbCrLf
    s = s & "    End If" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    'Enumerate the child windows of the dialog and write their properties to a dictionary" & vbCrLf
    s = s & "    WriteChildWindowsPropDict dlgHwnd" & vbCrLf
    s = s & "" & vbCrLf
    s = s & "    'the first window of class ""Edit"" inside ChildWindowsPropDict will be the filename box" & vbCrLf
    s = s & "    Dim v As Variant" & vbCrLf
    s = s & "    For Each v In ChildWindowsPropDict.items" & vbCrLf
    s = s & "        If Left(CStr(v(dc_ClassName)), Len(CStr(v(dc_ClassName))) - 1) = ""Edit"" Then" & vbCrLf
    s = s & "            tempHctrl = v(dc_Hwnd)" & vbCrLf
    s = s & "            'send message" & vbCrLf
    s = s & "            SendMessage tempHctrl, WM_SETTEXT, 0&, ByVal SvgFilePath & ""\"" & SvgFileName" & vbCrLf
    s = s & "            'we don't need this hwnd anymore" & vbCrLf
    s = s & "            ChildWindowsPropDict.Remove CStr(v(dc_Hwnd))" & vbCrLf
    s = s & "            Exit For" & vbCrLf
    s = s & "        End If" & vbCrLf
    s = s & "    Next v" & vbCrLf
    s = s & "" & vbCrLf
    s = s & "retry:" & vbCrLf
    s = s & "    SetForegroundWindow dlgHwnd" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    SendKeys ""{TAB}""" & vbCrLf
    s = s & "    Sleep 250" & vbCrLf
    s = s & "    SetForegroundWindow dlgHwnd" & vbCrLf
    s = s & "    For i = 1 To 10" & vbCrLf
    s = s & "        SendKeys ""{DOWN}""" & vbCrLf
    s = s & "        Sleep 100" & vbCrLf
    s = s & "        SetForegroundWindow dlgHwnd" & vbCrLf
    s = s & "    Next i" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    SendKeys ""~""" & vbCrLf
    s = s & "    Sleep 100" & vbCrLf
    s = s & "    SetForegroundWindow dlgHwnd" & vbCrLf
    s = s & "    SendKeys ""~""" & vbCrLf
    s = s & "    Sleep 50" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    'give the keystrokes time to process" & vbCrLf
    s = s & "    Sleep 300" & vbCrLf
    s = s & "" & vbCrLf
    s = s & "    'Wait until the file appears in the specified path:" & vbCrLf
    s = s & "    Dim cleanFileName As String" & vbCrLf
    s = s & "    If InStr(1, Right(SvgFileName, 4), "".svg"", vbTextCompare) = 0 Then" & vbCrLf
    s = s & "        cleanFileName = SvgFileName & "".svg""" & vbCrLf
    s = s & "    Else" & vbCrLf
    s = s & "        cleanFileName = SvgFileName" & vbCrLf
    s = s & "    End If" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    Dim retryTime As Single" & vbCrLf
    s = s & "    retryTime = Timer + 5" & vbCrLf
    s = s & "    stopTime = Timer + 60  '1 minute timeout." & vbCrLf
    s = s & "                            'relatively long in case a file already exists dialog appears..." & vbCrLf
    s = s & "    Do Until ExistsFileInPath(SvgFileName, SvgFilePath, False)" & vbCrLf
    s = s & "        Sleep 700" & vbCrLf
    s = s & "        DoEvents" & vbCrLf
    s = s & "        If Timer > retryTime Then" & vbCrLf
    s = s & "            'check if graphic export dialog is top window" & vbCrLf
    s = s & "            If dlgHwnd = GetForegroundWindow Then GoTo retry" & vbCrLf
    s = s & "        End If" & vbCrLf
    s = s & "        If Timer > stopTime Then GoTo timeoutHand" & vbCrLf
    s = s & "    Loop" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "    Exit Sub" & vbCrLf
    s = s & "errHand:" & vbCrLf
    s = s & "    MsgBox ""Error in the helper process""" & vbCrLf
    s = s & "    GoTo badExit" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "timeoutHand:" & vbCrLf
    s = s & "    MsgBox ""Timeout. It seems like something went wrong creating the file. File "" & cleanFileName & "" didn't appear in folder "" & SvgFilePath & "".""" & vbCrLf
    s = s & "    GoTo badExit" & vbCrLf
    s = s & "    " & vbCrLf
    s = s & "badExit:" & vbCrLf
    s = s & "    MsgBox ""Shutting down background instance of excel.""" & vbCrLf
    s = s & "    Application.DisplayAlerts = False" & vbCrLf
    s = s & "    Application.Quit" & vbCrLf
    s = s & "End Sub" & vbCrLf
    s = s & "" & vbCrLf
    CreateCodeForOtherXlInstance = s
End Function