将Excel图形导出为* .emf

Question

我发现该邮件正在调查中，但很遗憾，我没有回答我想到的问题如何从EXCEL AS * .EMF导出图

Excel export chart to wmf or emf?

所提供的代码对我不起作用。我所做的是像这样的“私有声明PtrSafe函数”那样扩展每个“私有声明函数”，以使其适用于64BIT。

我想使用此代码将具有工作表名称的工作表中的图形自动导出到循环中的特定文件夹，以备不时之需。突出显示的是是否可以通过按钮执行该操作。

到目前为止，当我运行代码时，我得到的只是一条“ NOT SAVED”消息。我正在使用Excel 365 ProPlus，以防万一。

如果有人向我解释此代码的工作方式以及在那里需要实现的功能，我将不胜感激

我发现进行了调查，但不幸的是没有回答我想到的有关如何从EXCEL AS * .EMF导出图表的问题。EMFExcel将图表导出到wmf或emf？显示的代码...

Answer 1

这是我使用的一些代码，直接模仿人机交互的user32函数是本人通过vba将聊天保存为不同格式的唯一途径，它的当前语句也适用于活动工作表/工作簿，显然可以如果您构建了一个将图表保留在其他工作表上的仪表板，则进行了更改；如果有任何疑问，可以通过[email protected]向我发送电子邮件；

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


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

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

End Sub