直接粘贴剪贴版的位图数据到Image控件_vba: image控件加载剪贴板图片-优快云博客

本文链接：https://blog.youkuaiyun.com/LucasLynn/article/details/466852

博客展示了图像粘贴功能的代码实现。包含调用范例和模块段代码，涉及剪贴板操作、内存复制等，还定义了多个二进制数据读取和写入函数，如Byt2Lng、Byt2Int等，用于处理图像数据。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

调用范例：

Private Sub Command1_Click()
PasteToImage Me.Image0
End Sub

模块段代码：

Option Compare Database
Option Explicit

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Public Const CF_TEXT = 1
Public Const CF_BITMAP = 2
Public Const CF_METAFILEPICT = 3
Public Const CF_DIB = 8
Public Const CF_ENHMETAFILE = 14

Public Sub PasteToImage(ByRef imgDest As Image)
    Dim hBMP As Long
    Dim arrData() As Byte
    Dim biClrUsed As Long, biSizeImage As Long

    OpenClipboard Application.hWndAccessApp
    hBMP = GetClipboardData(CF_DIB)
    CloseClipboard

    If hBMP <> 0 Then
        ReDim arrData(39)
        CopyMemory ByVal VarPtr(arrData(0)), ByVal hBMP, 40

        biClrUsed = ReadBytes(arrData, 32, 2)
        biSizeImage = ReadBytes(arrData, 20, 4)

        ReDim arrData(39 + biClrUsed * 8 + biSizeImage)

        CopyMemory ByVal VarPtr(arrData(0)), ByVal hBMP, 40 + biClrUsed * 8 + biSizeImage

        imgDest.PictureData = arrData
    End If
End Sub

'以下均为二进制数据读取函数
Public Function Byt2Lng(ByRef arrData() As Byte, ByVal p As Long) As Long
CopyMemory VarPtr(Byt2Lng), VarPtr(arrData(p)), 4
End Function

Public Function Byt2Int(ByRef arrData() As Byte, ByVal p As Long) As Integer
CopyMemory VarPtr(Byt2Int), VarPtr(arrData(p)), 2
End Function

Public Function ReadBytes(arrData() As Byte, p As Long, t As Integer) As Long
If t >= 1 And t <= 4 Then CopyMemory VarPtr(ReadBytes), VarPtr(arrData(p)), t
End Function

Public Sub WriteBytes(ByRef arrData() As Byte, p As Long, Value As Long, t As Integer)
If t >= 1 And t <= 4 Then CopyMemory VarPtr(arrData(p)), VarPtr(Value), t
End Sub