把execl插入的图片转换成StdPicture格式，任意使用

execl插入的图片不能被直接拿来使得，查边网络，没有很好的解决方案。只能人工智能给出两种解决方案。

1、转存成临时的图片文件，然后再LoadPicture。

2、放到Clipboard，然后再取出生成StdPicture。

本人倾向于第二种，放代码，然后上传资源，方便大家使用

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
Private Declare Function CLSIDFromStringAPI Lib "ole32.dll" Alias "CLSIDFromString" (ByVal lpsz As Long, ByRef pclsid As GUID) 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 Type PICTDESC
    cbSize As Long
    picType As Long
    hPic As Long
    hPal As Long
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fOwn As Long, iPic As IPictureDisp) As Long

Private Const CF_BITMAP As Long = 2
Private Const PICTYPE_BITMAP = 1


Public Function Paste2StdPicture() As IPictureDisp
    Dim IID_IDispatch As GUID
    Dim PICTDESC As PICTDESC

    Dim h As Long, hPtr As Long

    ' 取得剪贴板中图片的句柄
    OpenClipboard ByVal 0
    h = GetClipboardData(CF_BITMAP)
    CloseClipboard

    If h = 0 Then Exit Function

    ' 创建临时图像对象
    Call CLSIDFromStringAPI(StrPtr("{00020400-0000-0000-C000-000000000046}"), IID_IDispatch)
    
    With PICTDESC
        .cbSize = Len(PICTDESC)
        .picType = PICTYPE_BITMAP
        .hPic = h
    End With

    OleCreatePictureIndirect PICTDESC, IID_IDispatch, 1, Paste2StdPicture

End Function

vba中form中放一image控件，拷贝如下代码

Option Explicit

Private Sub UserForm_Initialize()
    Sheet1.Shapes(1).CopyPicture , xlBitmap
    Set Me.Image1.Picture = modPaste2StdPicture.Paste2StdPicture()
End Sub

Sheet1.Shapes(1).CopyPicture , xlBitmap’关键是要拷贝成xlBitmap格式，否则不能从Clipboard取出来

效果图

wa

代码如何使用，这个依靠大家。反方向大家可以用

更多信息，请大家移步本个的个人网站