调用范例：
Private Sub Command1_Click()
PasteToImage Me.Image0
End Sub
模块段代码：
Option Compare Database
Option Explicit
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 a() As Byte, ByVal p As Long) As Long
If a(p + 3) <= 127 Then
Byt2Lng = ((CLng(a(p + 3)) * 256 + a(p + 2)) * 256 + a(p + 1)) * 256 + a(p)
Else
Byt2Lng = -1 - (((CLng(Not a(p + 3)) * 256 + (Not a(p + 2))) * 256 + (Not a(p + 1))) * 256 + (Not a(p)))
End If
End Function
Public Function Byt2Int(ByRef a() As Byte, ByVal p As Long) As Integer
If a(p + 1) <= 127 Then
Byt2Int = CInt(a(p + 1)) * 256 + a(p)
Else
Byt2Int = CInt(Not a(p + 1)) * 256 + (Not a(p)) + 1
End If
End Function
Public Function ReadBytes(a() As Byte, p As Long, t As Integer) As Long
If t = 1 Then
ReadBytes = a(p)
ElseIf t = 2 Then
ReadBytes = Byt2Int(a, p)
ElseIf t = 4 Then
ReadBytes = Byt2Lng(a, p)
End If
End Function