全局代码有如下代码:
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)
fnSaveAsEMF = (ReturnValue <> 0)
End Function
命令窗口有如下代码,在桌面上建立图片文件夹,内放a.xlsx文件。执行至黄色代码处 出现闪退,不知何原因,请指教!
Dim App As New MSExcel.Application
App.Visible = True
Dim Wb As MSExcel.Workbook = App.WorkBooks.Open("C:\Users\wuyong\Desktop\图片\a.xlsx")
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)'指定工作表
Dim Co As MSExcel.ChartObject = Ws.ChartObjects(1)
Dim Cht As MSExcel.Chart = Co.Chart
cht.ChartArea.Select
app.Selection.Copy
messagebox.show("01")
If fnSaveAsEMF("C:\Users\wuyong\Desktop\图片\001.emf") Then
messagebox.show("1")
Else
messagebox.show("2")
End If
[此贴子已经被作者于2021/3/4 23:45:49编辑过]