The below code is used to export chart as vector image (non-pixcel oriented) such as .wmf or .emf images.
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()
Dim CurrentChart As Chart
Set CurrentChart = Sheets("Charts").ChartObjects(1).Chart
'Charts.Add
CurrentChart.ChartArea.Select
Selection.Copy
If fnSaveAsEMF("C:\Excel002.emf") Then
MsgBox "Saved", vbInformation
Else
MsgBox "NOT Saved!", vbCritical
End If
End Sub
What I need to change in the code to save as WMF?
ReplyDeleteThis is a very old post, I realize, but this function is exactly what I'm looking for. I can get the above code to run (Win 10, Office 2013), and an EMF file is successfully output. However, though the EMF opens and displays correctly in Office (Word, PowerPoint), it looks dramatically different in other programs that normally handle EMFs quite well (CorelDraw). There appear to be multiple black layers stacked on top of the original image. Do you know why this might be? Is Microsoft doing something proprietary with their EMFs?
ReplyDelete