Option Explicit
Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" ( _
ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" ( _
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 LongPtr
Private Const CF_TEXT As Long = 1&
Private Const GMEM_MOVEABLE As Long = 2
Private Sub StringToClipboard(strText As String)
Dim lngptrIdentifier As LongPtr, lngptrPointer As LongPtr
lngptrIdentifier = GlobalAlloc(GMEM_MOVEABLE, CLngPtr(Len(strText) + 1))
lngptrPointer = GlobalLock(lngptrIdentifier)
Call lstrcpy(ByVal lngptrPointer, strText)
Call GlobalUnlock(lngptrIdentifier)
Call OpenClipboard(CLngPtr(0))
Call EmptyClipboard
Call SetClipboardData(CF_TEXT, lngptrIdentifier)
Call CloseClipboard
Call GlobalFree(lngptrIdentifier)
End Sub
Public Sub Schaltfläche1_Klicken()
Call StringToClipboard(ActiveSheet.Shapes("Textfeld 1").OLEFormat.Object.Text)
End Sub
Es kann sein, dass ich dir das auf 32Bit umbauen muss.
Public Sub Schaltfläche1_Klicken()
Dim objClipBoard As Object
Set objClipBoard = CreateObject(Class:="new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Call objClipBoard.SetText(ActiveSheet.Shapes("Textfeld 1").OLEFormat.Object.Text)
Call objClipBoard.PutInClipboard
Set objClipBoard = Nothing
End Sub
Ich bin mir aber nicht sicher dass es zu 100% funktioniert.
Range("A1").value = ActiveSheet.Shapes("Textfeld 1").OLEFormat.Object.Text
Range("A1").Copy
Gruß DanielDie erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen