在网上找了一个加载 excel 内部图片或图表 到窗体的函数,原码比较老,还是基于32位系统的;Declare 语句用ptrsafe标记了;然后olepro32替换成了oleaut32(在微软官方查oleloadpicture函数时发现微软偷偷把这玩意儿改到了oleaut32里...巨坑);
本人笔记本比较老,win7旗舰版,64位,用这段代码测试时ok,没啥问题;
公司电脑win10,64位系统,测试这段代码时窗体图片加载不出来,空白...
求各方大佬帮看下,是不是win10又改啥玩意儿了,还是说这个方法在win10中已经失效
下面附原码,未做修改的:
Option Explicit
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As Any) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
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
Private Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Public Function LoadShapePicture(shp As Object) As IPictureDisp
Dim nClipsize As Long
Dim hMem As Long
Dim lpData As Long
Dim sdata() As Byte
Dim fmt As Long
Dim fmtName As String
Dim iClipBoardFormatNumber As Long
Dim IID_IPicture(15)
Dim istm As stdole.IUnknown
If TypeName(shp) = "ChartObject" Then
shp.CopyPicture xlPrinter
Sheet1.Paste
Selection.Cut
Else
shp.Copy
End If
OpenClipboard 0&
If iClipBoardFormatNumber = 0 Then
fmt = EnumClipboardFormats(0)
Do While fmt <> 0
fmtName = Space(255)
GetClipboardFormatName fmt, fmtName, 255
fmtName = Trim(fmtName)
If fmtName <> "" Then
fmtName = Left(fmtName, Len(fmtName) - 1)
If fmtName = "GIF" Then
iClipBoardFormatNumber = fmt
Exit Do
End If
End If
fmt = EnumClipboardFormats(fmt)
Loop
End If
hMem = GetClipboardData(iClipBoardFormatNumber)
If CBool(hMem) Then
nClipsize = GlobalSize(hMem)
lpData = GlobalLock(hMem)
GlobalUnlock hMem
If CreateStreamOnHGlobal(hMem, 1, istm) = 0 Then
If CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture(0)) = 0 Then
Call OleLoadPicture(ByVal ObjPtr(istm), nClipsize, 0, IID_IPicture(0), LoadShapePicture)
End If
End If
End If
EmptyClipboard
CloseClipboard
End Function