Hello ElHa$on,
This version will work on all platforms of Windows and Office.
Option Explicit
Private Const CF_TEXT As Long = 1
Private Const GMEM_MOVEABLE As Long = 2
#If VBA7 Then
' // Code is running in VBA version 7.
#If Win64 Then
' // Running in Office 64 bit version.
Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function GlobalFree Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" (ByVal lpStr1 As Any, ByVal lpStr2 As Any) As Long
Private lngIdentifier As LongPtr
Private lngPointer As LongPtr
#Else
' // Running in Office 32 bit version.
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, 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 Function GlobalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" (ByVal lpStr1 As Any, ByVal lpStr2 As Any) As Long
Private lngIdentifier As Long
Private lngPointer As Long
#End If
#Else
' // Code is running in VBA version 6 or earlier.
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, 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 Function GlobalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" (ByVal lpStr1 As Any, ByVal lpStr2 As Any) As Long
Private lngIdentifier As Long
Private lngPointer As Long
#End If
Sub CopyContent()
Call StringToClipboard(ActiveCell.Value)
End Sub
Private Sub StringToClipboard(strText As String)
lngIdentifier = GlobalAlloc(GMEM_MOVEABLE, Len(strText) + 1)
lngPointer = GlobalLock(lngIdentifier)
Call lstrcpy(ByVal lngPointer, strText)
Call GlobalUnlock(lngIdentifier)
Call OpenClipboard(0&)
Call EmptyClipboard
Call SetClipboardData(CF_TEXT, lngIdentifier)
Call CloseClipboard
Call GlobalFree(lngIdentifier)
End Sub
Bookmarks