Option Explicit
Option Compare Text
Option Private Module
#If Mac Then
'
#Else
#If VBA7 Then
Private Declare PtrSafe Function ScreenToClient Lib "USER32" (ByVal Hwnd As LongPtr, lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32.dll" (ByVal Hwnd As LongPtr, ByVal lCmdShow As Long) As Boolean
Private Declare PtrSafe Function LockWindowUpdate Lib "USER32" (ByVal hwndLock As LongPtr) As Long
#Else
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal lCmdShow As Long) As Boolean
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias "GetTickCount" () As Long
#Else
Private Declare Function GetTickCount Lib "kernel32" () As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "USER32" (ByVal wFormat As LongPtr) As Long
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "USER32" () As Long
Private Declare PtrSafe Function OpenClipboard Lib "USER32" (ByVal Hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "USER32" () As Long
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function wstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Function wstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "USER32" (ByVal wFormat As LongPtr) As LongPtr
Private Declare PtrSafe Function SetClipboardData Lib "USER32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, source As Any, ByVal Length As LongPtr)
#Else
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function wstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
Private Declare Function wstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
#End If
#End If
Public ClipboardStorage As String
'=================================================================================
' ClipBoard
'=================================================================================
Sub PasteFromClipboard()
SendKeys "^v", False
AOT2 TimeSerial(0, 0, 1), "ClipboardReturnLast", True
End Sub
Function PasteText(ByVal text As String)
' Dán vãn baÒn bãÌng phím tãìt Ctrl+V
ClipboardSet text, True
SendKeys "^v", False
AOT2 TimeSerial(0, 0, 1), "ClipboardReturnLast", True
End Function
Sub ClipboardReturnLast()
ClipboardSet ClipboardStorage
ClipboardStorage = Empty
End Sub
Private Sub test()
Dim s
s = ClipboardText
Debug.Print Len(s); """" & s & """"
End Sub
Function ClipboardText() As String
#If Mac Then
With New MSForms.DataObject: .GetFromClipboard: ClipboardText = .GetText(1): End With
#Else
#If VBA7 Then
Dim h1 As LongPtr, h2 As LongPtr, l&, s$
#Else
Dim h1&, h2&, l&, s$
#End If
If IsClipboardFormatAvailable(13) Then
If OpenClipboard(0) Then
h1 = GetClipboardData(13): h2 = GlobalLock(h1): l = wstrlen(h2)
If l > 0 Then s = String$(l, vbNullChar): wstrcpy StrPtr(s), h2
GlobalUnlock (h1): CloseClipboard
ClipboardText = s
End If
End If
#End If
End Function
Public Function ClipboardSet(Optional ByVal text As String = vbNullChar, Optional backup As Boolean = False) As Boolean
#If Mac Then
With New MSForms.DataObject
If backup Then ClipboardStorage = Empty: .GetFromClipboard: ClipboardStorage = .GetText(1)
.SetText text: .PutInClipboard:
End With
#Else
#If VBA7 Then
Dim h1 As LongPtr, h2 As LongPtr, h3 As LongPtr, x&, s$
#Else
Dim h1&, h2&, h3&, x&, s$
#End If
If OpenClipboard(0&) = 0 Then Exit Function
If text = vbNullChar Then
x = EmptyClipboard()
Else
If backup Then
ClipboardStorage = Empty
If IsClipboardFormatAvailable(13&) Then
h1 = GetClipboardData(13&): h2 = GlobalLock(h1): x = wstrlen(h2)
If x > 0 Then s = String$(x, vbNullChar): wstrcpy StrPtr(s), h2
GlobalUnlock h1
ClipboardStorage = s
End If
End If
h1 = GlobalAlloc(&H42, LenB(text) + 2)
h3 = GlobalLock(h1)
h3 = wstrcpy(h3, StrPtr(text))
If GlobalUnlock(h1) <> 0 Then GoTo e
x = EmptyClipboard()
h2 = SetClipboardData(13&, h1)
ClipboardSet = True
End If
e:
If CloseClipboard() = 0 Then ClipboardSet = False
#End If
End Function
