我有一列。列中的每一行在评论中都有一张图片。
我如何在用户窗体中显示评论中的图片?
如果我无法使用用户表单执行操作,是否有其他方法?
[如果您不介意使用剪贴板和某些API,这会让您入门(需要在用户窗体上使用图像控件,并在“ A1”单元格中添加带有背景图片的注释)。不包括错误处理。将其放入您的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