Saturday, 16 June 2012

Export Chart as Vector Image (*.WMF, *.EMF)

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)

'// 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


    If fnSaveAsEMF("C:\Excel002.emf") Then
    MsgBox "Saved", vbInformation
    MsgBox "NOT Saved!", vbCritical
    End If
End Sub

No comments:

Post a Comment