Question

我有一列。列中的每一行在评论中都有一张图片。

如何在UserForm内显示评论中的图片？

如果我无法使用用户窗体进行操作，是否还有其他方法？

Answer 1

如果您不介意使用剪贴板和某些API，这将帮助您入门（需要UserForm上的Image控件和“ A1”单元格中带有背景图片的Comment）。不包括错误处理。将其放入您的UserForm代码中。

Const CF_BITMAP = 2
Const IMAGE_BITMAP = 0
Const LR_COPYRETURNORG = &H4

Private Type uPicDesc
    Size As Long
    Type As Long
    hPic As Long
    hPal As Long
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type


#If Win64 = 1 And VBA7 = 1 Then
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function CopyImage Lib "user32" (ByVal hwnd As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
    Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
#Else
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function CopyImage Lib "user32" (ByVal hwnd As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long '
    Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
#End If


Private Function DefinePicture(ByVal hPic As Long, ByVal hPal As Long) As IPicture
    Dim pInfo As uPicDesc, pGUID As GUID, iPic As IPicture
    Const PICTYPE_BITMAP = 1
    With pGUID
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B: .Data4(1) = &HBB: .Data4(2) = 0: .Data4(3) = &HAA: .Data4(4) = 0: .Data4(5) = &H30: .Data4(6) = &HC: .Data4(7) = &HAB
    End With
    With pInfo
        .Size = Len(pInfo)
        .Type = PICTYPE_BITMAP
        .hPic = hPic
        .hPal = hPal
    End With
    OleCreatePictureIndirect pInfo, pGUID, True, iPic
    Set DefinePicture = iPic
End Function

Private Sub UserForm_Activate()
   With Range("A1").Comment
        .Visible = True
        .Shape.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
        .Visible = False
    End With
    OpenClipboard 0&
    Image1.Picture = DefinePicture(CopyImage(GetClipboardData(CF_BITMAP), IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG), 0)
    CloseClipboard
End Sub

Excel VBA：如何从UserForm内部的注释中显示图片？

1 个答案: