export Excel graphs as *.emf - excel

Question

I found that post investigating, but unfortunately not answering the question which came to my mind on
HOW TO EXPORT GRAPHS FROM EXCEL AS *.EMF
Excel export chart to wmf or emf?
The code presented is not working for me.
What I did is to extend each "Private Declare Function" like this "Private Declare PtrSafe Function" to make it applicable for 64BIT.
CODE:
Option Explicit
Private Declare PtrSafe Function OpenClipboard _
Lib "user32" ( _
ByVal hwnd As Long) _
As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GetClipboardData _
Lib "user32" ( _
ByVal wFormat As Long) _
As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
'// CreateMetaFileA DeleteEnhMetaFile
Private Declare PtrSafe Function CopyEnhMetaFileA _
Lib "gdi32" ( _
ByVal hENHSrc As Long, _
ByVal lpszFile As String) _
As Long
Private Declare PtrSafe 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()
Charts.Add
ActiveChart.ChartArea.Select
Selection.Copy
If fnSaveAsEMF("C:\Excel001.emf") Then
MsgBox "Saved", vbInformation
Else
MsgBox "NOT Saved!", vbCritical
End If
I want to use this code to export graphs from worksheets with their worksheet name automatically to a specific folder within a loop in case thats possible. Highlight would be if its possible to execute that via a button.
So far when i run the code All I get is a "NOT SAVED" message. Im using Excel 365 ProPlus, in case thats of any relevance.
I would highly appreciate if someone would explain me how this code is working and what i need to implement there

Answer 1

The OP code worked for me after commenting out the Charts.add line and changing the write destination to a path where I had write privileges
Option Explicit
Private Declare PtrSafe Function OpenClipboard _
Lib "user32" ( _
ByVal hwnd As Long) _
As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GetClipboardData _
Lib "user32" ( _
ByVal wFormat As Long) _
As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
'// CreateMetaFileA DeleteEnhMetaFile
Private Declare PtrSafe Function CopyEnhMetaFileA _
Lib "gdi32" ( _
ByVal hENHSrc As Long, _
ByVal lpszFile As String) _
As Long
Private Declare PtrSafe 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()
'Charts.Add
ActiveChart.ChartArea.Select
Selection.Copy
If fnSaveAsEMF("m:\mpo\autompo\test.emf") Then 'the name excluding the .emf can be changed
'Be sure you have write privileges here or you will get an error
MsgBox "Saved", vbInformation
Else
MsgBox "NOT Saved!", vbCritical
End If
End Sub
This is effectively the same answer as #kuv , but adds in the PtrSafe modifier to the windows function calls (these are required with 64 bit excel.

Answer 2

this is some code that i have used, the user32 function which imitates human interaction directly is the only way ive come across to save chats as different formats via vba, also its current statements are for an active sheet/workbook which can obviously be altered if you building a dashboard where the charts remain on other sheets, if you have any queries you can email me on howtovba#gmail.com;
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()
Charts.Add
ActiveChart.ChartArea.Select
Selection.Copy
If fnSaveAsEMF("C:\Excel001.emf") Then 'the name excluding the .emf can be changed
MsgBox "Saved", vbInformation
Else
MsgBox "NOT Saved!", vbCritical
End If
End Sub