Copy Chart as a Picture
I needed to copy a chart to a picture, but I wanted it to be an enhanced metafile (EMF) which is kind of like a vector graphic picture format. EMF graphics scale well when the page resizes.
A user would select the chart, run the macro and a dialog would ask them where to save the picture to – pretty simple, but handy!
It uses the clipboard to do the conversion.
Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function CopyEnhMetaFileA Lib "gdi32" (ByVal hENHSrc As Long, ByVal lpszFile As String) As Long
Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hemf As Long) As Long
Const CF_ENHMETAFILE As Long = 14
Const cInitialFilename = "Picture1.emf"
Const cFileFilter = "Enhanced Windows Metafile (*.emf), *.emf"
Public Sub SaveAsEMF()
Dim var As Variant, lng As Long
var = Application.GetSaveAsFilename(cInitialFilename, cFileFilter)
If VarType(var) <> vbBoolean Then
On Error Resume Next
Selection.Copy
OpenClipboard 0
lng = GetClipboardData(CF_ENHMETAFILE)
lng = CopyEnhMetaFileA(lng, var)
EmptyClipboard
CloseClipboard
DeleteEnhMetaFile lng
On Error GoTo 0
End If
End Sub
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function CopyEnhMetaFileA Lib "gdi32" (ByVal hENHSrc As Long, ByVal lpszFile As String) As Long
Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hemf As Long) As Long
Const CF_ENHMETAFILE As Long = 14
Const cInitialFilename = "Picture1.emf"
Const cFileFilter = "Enhanced Windows Metafile (*.emf), *.emf"
Public Sub SaveAsEMF()
Dim var As Variant, lng As Long
var = Application.GetSaveAsFilename(cInitialFilename, cFileFilter)
If VarType(var) <> vbBoolean Then
On Error Resume Next
Selection.Copy
OpenClipboard 0
lng = GetClipboardData(CF_ENHMETAFILE)
lng = CopyEnhMetaFileA(lng, var)
EmptyClipboard
CloseClipboard
DeleteEnhMetaFile lng
On Error GoTo 0
End If
End Sub
Very useful. Is it possible to do something similar but for pdf?
i have created a macro that saves the selected area to pdf but then i have to crop the page…
Very nice! Thanks for the new addition to my personal.xlsb!
This is really handy! Is there a way to suppress the dialog? For example if you wanted to incorporate this into an existing macro that runs through multiple charts in a Worksheet and prints them while also sending them to EMF? It seems easy enough to redefine the cInitialFilename variable to reflect the desired emf filename, but then you’d have to hit enter for each chart as it was saved out. The Excel help doesn’t indicate an option to suppress the dialog. Thanks!
One more possible modification would be to copy the EMF to the clipboard. This would make it easy to add the files to other documents or presentations. Thanks!
@A_Different_Eric
If you don’t want the dialog, then get rid of the line with “var = Application.GetSaveAsFilename(…”
All that the dialog does is give you the full name and path of where and what as you want to store the file. So if you know the name, then just substitute that for ‘var’ in the “lng = CopyEnhMetaFileA(lng, var)” line of code.
Excellent. Thanks a lot, I was just looking for a similar feature and here you are.
Excellent coding, short, efficient and robust.
Could you think of a way of saving an EMF of what should be rendered to the printer rather than what is on the screen ?
@Eric
Thanks. That rocks the sox off a fox.