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()
ActiveSheet.ChartObjects("图表 1").Activate
ActiveChart.ChartArea.Select
Selection.Copy
If fnSaveAsEMF("C:\Users\wuyong\Desktop\emf\Excel001.emf") Then
MsgBox "Saved", vbInformation
Else
MsgBox "NOT Saved!", vbCritical
End If
End Sub
在vba上试验成功，可以将图表（chart)存为emf格式文件，但将此段代码放在ft全局代码中，运行会出现闪退，请教如何修改？
加好友 
发短信
Post By：2021/1/3 22:14:00 [只看该作者]
