试试
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
'// CreateMetaFileA DeleteEnhMetaFile
Public Declare Function CopyEnhMetaFileA Lib "gdi32" (ByVal hENHSrc As Long, ByVal lpszFile As String) As Long
Public Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hemf As Long) As Long
Public Function fnSaveAsEMF(strFileName As String) As Boolean
Dim 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)
return (ReturnValue <> 0)
End Function
Sub SaveIt()
ActiveSheet.ChartObjects("图表 1").Activate
ActiveChart.ChartArea.Select
Selection.Copy
If fnSaveAsEMF("C:\Users\wuyong\Desktop\emf\Excel001.emf") Then
MsgBox( "Saved")
Else
MsgBox( "NOT Saved!")
End If
End Sub
加好友 
发短信
Post By：2021/1/3 22:31:00 [显示全部帖子]
