将 Excel 图表导出到 SVG 创建一个空文件

Question

我正在尝试使用 VBA 以 SVG 格式导出 Excel 图表。

    Set objChrt = ActiveChart.Parent
    objChrt.Activate
    Set curChart = objChrt.Chart
    
    curChart.Export fileName:=fileName, FilterName:="SVG"

如果我用“PNG”替换“SVG”，则导出完全按预期工作并生成有效的 PNG 文件。但是，“SVG”会生成一个空文件。（手动，有一个选项可以在 Excel 365 中另存为 SVG，因此存在导出过滤器）。

根据文档，Filtername 是“图形过滤器在注册表中出现的与语言无关的名称。”，但我在注册表中找不到类似的东西，无论哪种方式，都很难想象 SVG 过滤器名称被命名为“SVG”以外的任何名称。

有没有办法使用 VBA 以 SVG 格式导出图表？

---

注意：还有一个关于 Chart.export 生成空文件的问题，修复是ChartObject.Activate在导出之前使用。这个问题是不同的，因为代码在“PNG”下正常工作，但在“SVG”下失败（所以这不是与激活或可见性相关的问题）。推荐的修复也不起作用。

Answer 1

将图表复制到剪贴板时，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"