Excel导出图表到wmf或emf？

Question

我试图将图表从Excel导出为wmf或emf格式.

如果您导出到GIF但不是WMF作为filtername,则代码有效.

这有效:

Chart.Export FileName:="current_sales.gif", FilterName:="GIF"

但

Chart.Export FileName:="current_sales.wmf", FilterName:="WMF"

没有给出错误:

运行时错误'1004':应用程序定义的错误或对象定义的错误

Powerpoint允许您导出到WMF.我通过将图形复制到Powerpoint并让Powerpoint将图像导出到WMF来"成功"导出,但我必须有一种更简单的方法.

我想知道是否有办法为Excel注册WMF过滤器,但我不确定如何做到这一点.请帮忙!谢谢.

Answer 1

这个副本,保存方法对我有用,我将它分为3个部分(声明,保存为EMF函数,以及选择/复制/函数调用部分):

*我发现这篇文章详细说明了如何保存到EMF,然后使用ActiveChart而不是任意选择进行了一些修改.

首先是几个声明:

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

这是实际保存为emf函数(文章中解释了CopyEnhMetaFileA和DeleteEnhMetaFile的使用):

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
        MsgBox "Saved", vbInformation
    Else
        MsgBox "NOT Saved!", vbCritical
    End If

End Sub