'Private Const GMEM_MOVEABLE As Long = &H2
'Private Const GMEM_DDESHARE As Long = &H2000
'Private Const CF_UNICODETEXT = 13
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Function ListClipboardFormats() As String
Dim format As Long, formatname As String, size As Long, res As String, hData As Long, pData As Long, m() As Byte, Text As String
If OpenClipboard(0) = 0 Then Exit Function
format = EnumClipboardFormats(0)
Do While format > 0
formatname = String(64, Chr(0))
size = GetClipboardFormatName(format, formatname, 64)
formatname = Left(formatname, size)
res = res & "Format = " & format & ", FormatName = " & formatname & vbCrLf
format = EnumClipboardFormats(format)
Loop
ListClipboardFormats = res
CloseClipboard
Range("A1").Value = res
End Function
Sub GetClipboardObjectLinkFormat()
Dim Text As String, format As Long, m() As Byte, hData As Long, pData As Long, size As Long
Dim formatname As String
On Error Resume Next
If OpenClipboard(0) = 0 Then Exit Sub
format = EnumClipboardFormats(0)
Do While format > 0
formatname = String(64, Chr(0))
size = GetClipboardFormatName(format, formatname, 64)
formatname = Left(formatname, size)
If formatname = "ObjectLink" Then
' trong ClipBoard coě Format - ObjectLink, vâňy ta đoňc Handle cuŇa Data
hData = GetClipboardData(format)
If hData = 0 Then MsgBox GetLastError
' muôěn đoňc Data thiĚ trýőěc hęět phaŇi coě "điňa chiŇ" cuŇa Data trong RAM - đoňc ra băĚng haĚm GlobalLock
pData = GlobalLock(hData)
' đôň lőěn cuŇa Data đoňc ra băĚng haĚm GlobalSize
size = GlobalSize(hData)
' chuâŇn biň maŇng coě đôň lőěn thiěch hőňp đęŇ đoňc Data
ReDim m(0 To size - 1)
' cheěp toaĚn bôň Data vaĚo maŇng
CopyMemory m(0), ByVal pData, size
' cuôěi cuĚng laĚ UnLock
GlobalUnlock hData
Text = m
Text = StrConv(Text, vbUnicode)
Text = Replace(Text, Chr(0), vbCrLf)
Range("A1").Value = Text
Exit Do
End If
format = EnumClipboardFormats(format)
Loop
CloseClipboard
End Sub
