PinToClipboard macht nur Hyroglyphen

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Range("B:B"), Target) Is Nothing Then If Target.Offset(0, 41).Value > "" Then Dim objBeleglink As MSForms.DataObject Set objBeleglink = New MSForms.DataObject objBeleglink.SetText CStr(Target.Offset(0, 41).Value) Debug.Print CStr(Target.Offset(0, 41).Value) objBeleglink.PutInClipboard End If Cancel = True End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Flo,

im Modul der Tabelle:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

    If Not Intersect(Columns(2), Target) Is Nothing Then

        If Not IsEmpty(Target.Offset(0, 41).Value) Then

            Call StringToClipboard(Target.Offset(0, 41).Text)

        End If

        Cancel = True

    End If

End Sub

In einem Standardmodul:

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&

Public 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

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

PinToClipboard macht nur Hyroglyphen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread