Question

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:

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

But

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

fails giving the error:

Run-time error ‘1004’:
Application-defined or object-defined
error

Powerpoint allows you to export to WMF. And I have “successfully” exported by copying the graph into Powerpoint and having Powerpoint export the image to WMF but there has to be an easier way – I hope.

I wonder if there may be a way of registering the WMF filter for Excel but I am unsure how to do this. Please help! Thanks.

Answer 1

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