Zwischenablage

[PeterW]

Seit dem ich Officce 365 habe, funktioniert das Schreiben in und das Lesen aus der Zwischenablage nicht mehr.
Ich such nach der Ursache.Sie dürfen in diesem Board keine Dateianhänge sehen.Sie dürfen in diesem Board keine Dateianhänge sehen. 

[PhilS]

Das ist eine benutzerdefinierte Fehlermeldung, die uns leider absolut gar nichts sagt, solange du nicht auch den VBA-Code, der den Fehler auslöst, zeigst.

[PeterW]

Ich habe das Klassemodul vor längerer Zeit gefunden und in meinem Projekt erfolgreich verwendet. Plötzlich funktioniert es nicht mehr undichhabe keine Ahnung warum.

Code [Auswählen] Erweitern

Option Compare Database
Option Explicit

'----------------------------------------------------------------------------------
' Einsatz:
'          dim Clipboard as new ClpBrd
'' Methoden:
'          Clipboard.SetData <Data>
''              Daten in die Zwischenablage kopieren...
''              <Data>= String-Konstante oder String-Variable
'                      Beispiel:
'                      X$= DLookUp("[Feld]","[Tabelle]",SQL$)
'                      Clipboard.SetData X$
'                      oder
'                      Clipboard.SetData "Testtext"
''          X$ = Clipboard.GetData()
''              Daten aus der Zwischenablage holen...
''              X$=    String-Variable oder direkt im Ausdruck
'                      Beispiel:
'                      X$= Clipboard.GetData()
'                      oder
'                      rs("Feld")= "Test: " & Clipboard.GetData()
''          Clipboard.Clear
''              Löscht den aktuellen Inhalt der Zwischenablage...
''          Clipboard.ClpBrdEmpty()
''              True, wenn Zwischenablage leer ist, sonst False
''----------------------------------------------------------------------------------
'API-Funktionen für Clipboard...
Private Declare PtrSafe Function CountClipboardFormats Lib "user32" () As Long
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long

'API-Funktionen für Speicher-Operationen...
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare PtrSafe Function lStrCpy Lib "kernel32" Alias "lstrcpy" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

Private Const GHND = &H42
Private Const CF_TEXT = 1
Private Const MAXSIZE = 32768

Sub Clear()
    Dim lngRetVal As Long
   
    If OpenClipboard(0&) <> 0 Then
        lngRetVal = EmptyClipboard()
        lngRetVal = CloseClipboard()
    End If
End Sub

Function ClpBrdEmpty() As Boolean
    Dim lngRetVal As Long
    lngRetVal = CountClipboardFormats()
    ClpBrdEmpty = (lngRetVal = 0) Or (IsClipboardFormatAvailable(CF_TEXT) = 0)
End Function

Function GetData()
    Dim hClipMemory As Long
    Dim lpClipMemory As Long
    Dim strCBData As String
    Dim lngRetVal As Long
    strCBData = ""
    If ClpBrdEmpty() Then
        Beep
        MsgBox "ClpBrd/Get: Zwischenablage ist leer...", vbCritical
        Exit Function
    End If
    If IsClipboardFormatAvailable(CF_TEXT) = 0 Then
        Beep
        MsgBox "ClpBrd/Get: Zwischenablage enthält keinen Text...", vbCritical
        Exit Function
    End If
 
    If OpenClipboard(0&) = 0 Then
        Beep
        MsgBox "ClpBrd/Get: Zwischenablage kann nicht geöffnet werden...", vbCritical
        Exit Function
    End If

    hClipMemory = GetClipboardData(CF_TEXT)
    If IsNull(hClipMemory) Then
        Beep
        MsgBox "ClpBrd/Get: Fehler beim Lesen der Zwischenablage..."
        strCBData = ""
        GoTo EndeFunc
    End If

    lpClipMemory = GlobalLock(hClipMemory)

    If Not IsNull(lpClipMemory) Then
        strCBData = Space$(MAXSIZE)
        lngRetVal = lStrCpy(strCBData, lpClipMemory)
        lngRetVal = GlobalUnlock(hClipMemory)

        On Error Resume Next
        strCBData = Mid(strCBData, 1, InStr(1, strCBData, Chr$(0), 0) - 1)
        If Err <> 0 Then
            Beep
            MsgBox "ClpBrd/Get: Ungültiges Format ...", vbCritical
            strCBData = ""
        End If
    Else
        Beep
        MsgBox "ClpBrd/Get: Fehler beim Kopieren aus Zwischenablage...", vbCritical
    End If
EndeFunc:
    lngRetVal = CloseClipboard()
    GetData = strCBData
End Function

Function SetData(strCBData As String) As Boolean
    Dim hGlobalMemory As Long
    Dim lpGlobalMemory As Long
    Dim hClipMemory As Long
    Dim lngRetVal As Long
    SetData = False
    hGlobalMemory = GlobalAlloc(GHND, Len(strCBData) + 1)
    lpGlobalMemory = GlobalLock(hGlobalMemory)
    lpGlobalMemory = lStrCpy(lpGlobalMemory, strCBData)
    If GlobalUnlock(hGlobalMemory) <> 0 Then
        Beep
        MsgBox "ClpBrd/Set: Fehler beim Kopieren in die Zwischenablage...", vbCritical
        GoTo EndeFunc
    End If

    If OpenClipboard(0&) = 0 Then
        Beep
        MsgBox "ClpBrd/Set: Zwischenablage konnte nicht geöffnet werden...", vbCritical
        GoTo EndeFunc
    End If

    lngRetVal = EmptyClipboard()
    hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
    SetData = True
EndeFunc:
    If CloseClipboard() = 0 Then
        Beep
        MsgBox "ClpBrd/Set: Fehler beim Zugriff auf die Zwischenablage...", vbCritical
        SetData = False
    End If
End Function

[Knobbi38]

Hallo Peter,

... vor längerer Zeit gefunden ...

Wo ist die Quellenangabe, wenn du schon den Code "gefunden" hast?
Dann könnte man zumindest im Original den Kontext nachlesen oder den Urheber auf den Fehler ansprechen.

Da eine konkrete Fehlermeldung des API-Aufrufs nicht weiter ausgewertet wird, vermute ich mal ganz stark, daß du jetzt eine 64Bit Version installiert hast, der "gefundene" Code ist aber so nur für 32Bit gedacht. Da müsstest du also nochmal den Code, insbesondere die API-Deklarationen entsprechend anpassen.
(siehe https://codekabinett.com/rdumps.php?Lang=1&targetDoc=windows-api-deklaration-vba-64-bit)


Gruß Knobbi38


Noch eine Bitte:
Damit der Code besser lesbar ist, bitte dafür beim nächsten mal die entsprechenden Code-Tags verwenden.

[Bitsqueezer]

Hallo,

es genügt bei API-Calls nicht, wenn man sie für 64 Bit tauglich machen will, daß man nur ein "PtrSafe" dazwischenklatscht.

Auch die Parameter müssen angepaßt werden, denn "Long" ist 32Bit. Und nicht jedes Long muß zu 64Bit konvertiert werden, nur die, die eine Speicheradresse darstellen (z.B. "hWnd" in der Regel immer).

Gruß

Christian

[PeterW]

Ja, mit Officce 365 habe ich eine 64bit Version und nun ist mir klar, was da passiert ist.
Aber die Anpassung ist jenseits meiner progammtechnischen Möglichkeiten (kurz: da blick ich nicht durch)
Gibt es denn irgendwo ein Modul, mit dem ich mein Problem lösen kann?
Vielen Dank für eure Infos

[Bitsqueezer]

Hallo,

findest Du z.B. hier:
https://codekabinett.com/rdumps.php?Lang=1&targetDoc=windows-api-deklaration-vba-64-bit

Da ist auch ein Link enthalten für die korrekte Deklaration:
https://www.microsoft.com/en-us/download/details.aspx?id=9970

Sind zwar nicht alle drin, da solltest Du aber fündig werden.

Gruß

Christian