Excel export chart to wmf or emf?

后端 未结 4 1983
孤街浪徒
孤街浪徒 2020-12-30 13:32

I am trying to export a chart from Excel to either the wmf or emf format.

The code works if you export to GIF but not with WMF as the filtername.

This works:

4条回答
  •  暗喜
    暗喜 (楼主)
    2020-12-30 14:04

    This copy, save method worked for me, i put it into 3 sections (declarations, saves as EMF function, and the select/copy/function call section):

    *I found this article detailing how to save to EMF then doctored it a bit to use the an ActiveChart instead of a arbitrary selection.

    First off a couple declarations:

    Option Explicit
    
    Private Declare Function OpenClipboard _
        Lib "user32" ( _
            ByVal hwnd As Long) _
    As Long
    
    Private Declare Function CloseClipboard Lib "user32" () As Long
    
    Private Declare Function GetClipboardData _
        Lib "user32" ( _
            ByVal wFormat As Long) _
    As Long
    
    Private Declare Function EmptyClipboard Lib "user32" () As Long
    
    '// CreateMetaFileA DeleteEnhMetaFile
    Private Declare Function CopyEnhMetaFileA _
        Lib "gdi32" ( _
            ByVal hENHSrc As Long, _
            ByVal lpszFile As String) _
    As Long
    
    Private Declare Function DeleteEnhMetaFile _
        Lib "gdi32" ( _
            ByVal hemf As Long) _
    As Long
    

    This is the actual save as emf function (the use of CopyEnhMetaFileA and DeleteEnhMetaFile are explained in the article):

    Public Function fnSaveAsEMF(strFileName As String) As Boolean
    Const CF_ENHMETAFILE As Long = 14
    
    Dim ReturnValue As Long
    
        OpenClipboard 0
    
        ReturnValue = CopyEnhMetaFileA(GetClipboardData(CF_ENHMETAFILE), strFileName)
    
        EmptyClipboard
    
        CloseClipboard
    
        '// Release resources to it eg You can now delete it if required
        '// or write over it. This is a MUST
        DeleteEnhMetaFile ReturnValue
    
        fnSaveAsEMF = (ReturnValue <> 0)
    
    End Function
    

    Then the select, copy, and function call section:

    Sub SaveIt()
    Charts.Add
        ActiveChart.ChartArea.Select
        Selection.Copy
        If fnSaveAsEMF("C:\Excel001.emf") Then
            MsgBox "Saved", vbInformation
        Else
            MsgBox "NOT Saved!", vbCritical
        End If
    
    End Sub
    

提交回复
热议问题