DataObject : PutInClipboard funktioniert nicht

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
UserForm MsgBox
Bild

Betrifft: DataObject : PutInClipboard funktioniert nicht
von: NoNet
Geschrieben am: 19.05.2015 16:16:47

Hallo Excel VBA-PROFIS,
ich habe 2 PCs mit folgender Software Konfiguration :
PC1 : Windows 7 Enterprise (64 Bit) + Office 365 ProPlus bzw. 2013 (32 Bit)
PC2 : Windows 8.1 Profess. (64 Bit) + Office 365 Sm.Bus. bzw. 2013 (32 Bit)
Vorgaben :
In einer Excel-Mappe bzw. AddIn verwende ich einen Code zum Kopieren von Text in die Zwischenablage mittels DataObject (aus der FM20.DLL) - hier ein exemplarisches Code-Beispiel :

Sub TextInZwischenablage()
    'VBA : Extras => Verweise => "Microsoft Forms 2.0 Object Library" ist gesetzt
    
    'Pfad 32 Bit Windows : "C:\Windows\System32\fm20.dll"
    'Pfad 64 Bit Windows : "C:\Windows\SysWOW64\fm20.dll"
    
    Dim objClipboard As New DataObject
    Dim strText As String
    
    'auslesen der Zwischenablage :
    objClipboard.GetFromClipboard
    strText = objClipboard.GetText
    MsgBox strText
    
    'Neuen Text in Zwischenablage kopieren :
    strText = "Hello World !"
    objClipboard.SetText strText
    objClipboard.PutInClipboard
    
    'Text jetzt per Strg+V in Text-Editor / Word / Excel-Zelle einfügen
End Sub
Auf PC1 funktioniert der Code einwandfrei - sowohl Auslesen wie auch Kopieren in die Zwischenablage funktionieren wie gewünscht.
Auf PC2 gibt es folgende Probleme bzw. Merkwürdigkeiten :
- Der o.g. Code kopiert nur 2 Sonderzeichen ("??") in die Zwischenablage - egal welcher Text per Code kopiert werden soll !
- Der Verweis auf die "Microsoft Forms 2.0 Object Library" zeigt auf die Datei "C:\Windows\SysWOW64\fm20.dll" (Typisch für Windows 32 Bit DLLs unter 64 Bit Windows), die Datei existiert dort jedoch nicht. Dennoch ist der Verweis gesetzt !
Userbild
- Deaktiviert man den Verweis, befindet sich kein Eintrag "Microsoft Forms 2.0 Object Library" in der Liste (klaro, denn die Datei ist ja nicht vorhanden - übrigens auch nicht in "C:\Windows\System32\fm20.dll")
- Per VBA-Code kann der Verweis wieder gesetzt werden :
ActiveWorkbook.VBProject.References.AddFromGuid "{0D452EE1-E08F-101A-852E-02608C4D0BB4}" 'funktioniert
ActiveWorkbook.VBProject.References.AddFromFile "C:\Windows\SysWOW64\fm20.dll" ' funktioniert nicht - da Datei nicht vorhanden
Meine Fragen zu diesem Phänomen :
- Wer kann das Verhalten auf einer ähnlichen Software-Konfiguration reproduzieren ?
- Wie kann ich die "richtige" FM20.DLL im System des PC2 finden bzw. registrieren ?
- Gibt es eine Alternative zum DataObject bzgl. Kopieren von Text in die Zwischenablage per VBA ?
Das Verhalten hat vermutlich nichts mit dem bekannten ActiveX-Steuerelemente-Problem durch das Security-Update Ende 2014 zu tun, denn die ActiveX-Steuerlemente funktionieren auf beiden PCs sowhl auf dem Tabellenblatt wie auch in den UserForms einwandfrei !
Vielen Dank fürs Lesen, Mitdenken und für eure Unterstützung -
Salut, NoNet

Bild

Betrifft: AW: DataObject : PutInClipboard funktioniert nicht
von: ransi
Geschrieben am: 19.05.2015 16:36:35
Hallo,
Hatte mal ein ähnliches Problem.
Einfach ne Userform eingefügt und anschließend wieder gelöscht.
Eine Alternative wäre z.B. so:
Option Explicit
Public Sub lesen()
Dim IE As Object
Dim CLP As String
On Error Resume Next
Set IE = CreateObject("HTMLfile")
CLP = IE.ParentWindow.ClipboardData.GetData("text")
MsgBox CLP
Set IE = Nothing
End Sub
Public Sub schreiben()
Dim IE As Object
Dim DerText As String
Set IE = CreateObject("HTMLfile")
DerText = "ABCD"
IE.ParentWindow.ClipboardData.SetData "text", Chr(32) & DerText & Chr(32)
Set IE = Nothing
End Sub
rans

Bild

Betrifft: AW: DataObject : PutInClipboard funktioniert nicht
von: EtoPHG
Geschrieben am: 19.05.2015 16:55:23
Hallo NoNet,
Windows 8 hat ev. ein anderes Default-Format für die Zwischenablage.
Ich konnte das jetzt nicht testen, aber modifizier mal

    objClipboard.SetText strText, 1

Das sollte auf Win7 und 8 funktioneren.
Gruess Hansueli

Bild

Betrifft: AW: DataObject : PutInClipboard funktioniert nicht
von: Nepumuk
Geschrieben am: 19.05.2015 18:20:35
Hallo,
oder du gehst über die Registry:

Public Sub Rein()
    Dim objClipBoard As Object
    Set objClipBoard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Call objClipBoard.SetText("Hallo Welt")
    Call objClipBoard.PutInClipboard
    Set objClipBoard = Nothing
End Sub

Gruß
Nepumuk

Bild

Betrifft: AW: DataObject : PutInClipboard funktioniert nicht
von: Nepumuk
Geschrieben am: 19.05.2015 18:23:02
Und weil's so schön war gleich noch eins:

Option Explicit

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 Const CF_TEXT As Long = 1&

Private Const GMEM_MOVEABLE As Long = 2

Public Sub Beispiel()
    Call StringToClipboard("Hallo ...")
End Sub

Private Sub StringToClipboard(strText As String)
    Dim lngIdentifier As Long, lngPointer As Long
    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

Gruß
Nepumuk

Bild

Betrifft: AW: DataObject : PutInClipboard funktioniert nicht
von: Nepumuk
Geschrieben am: 19.05.2015 18:36:10
Nun noch für 64Bit:

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 Beispiel()
    Call StringToClipboard("Hallo ...")
End Sub

Private Sub StringToClipboard(strText As String)
    Dim lngptrIdentifier As LongPtr, lngptrPointer As LongPtr
    lngptrIdentifier = GlobalAlloc(GMEM_MOVEABLE, Len(strText) + 1)
    lngptrPointer = GlobalLock(lngptrIdentifier)
    Call lstrcpy(ByVal lngptrPointer, strText)
    Call GlobalUnlock(lngptrIdentifier)
    Call OpenClipboard(0&)
    Call EmptyClipboard
    Call SetClipboardData(CF_TEXT, lngptrIdentifier)
    Call CloseClipboard
    Call GlobalFree(lngptrIdentifier)
End Sub

Gruß
Nepumuk

Bild

Betrifft: Vielen Dank an alle - 3 funktionierende Lösungen
von: NoNet
Geschrieben am: 20.05.2015 10:42:16
Hallo Ransi, Hansueli, Nepumuk,
vielen Dank für eure konstruktiven und hilfreichen Antworten :-)
@Hansueli : Deine (triviale) Lösung wäre mir am liebsten gewesen, leider hatte sie jedoch nicht den gewünschten Effekt. Dennoch hat sie mir geholfen, das (neue ?) optionale Argument für .SetText kennenzulernen...
@ransi : Deine einfache und verständliche Lösung funktioniert einwandfrei, letztendlich habe ich mich dafür auch entschieden (war am wenigsten Modifikationsaufwand zum existierenden Code ;-). Interessant ist es, dass als erstes "Zeichen" des 2.Argumentes tatsächlich ein (Leer-)String angegeben werden (muss ?), ansonsten erscheint ein Laufzeitfehler "Ungültiges Argument". Bezogen auf Deinen Code habe ich das jedoch vereinfacht, um den kopierten Text in der Zwischenablage nicht zu verfälschen :

IE.ParentWindow.ClipboardData.SetData "text", "" & DerText
@Nepumuk : Deine API-Lösungen funktionieren (wie erwartet ;-) ebenfalls sehr gut. Der Code wirkt natürlich sehr professionell (wie von dir gewohnt !). ich werde mir diese Lösung als "Backup" auf jeden Fall konservieren, für den aktuellen Fall habe ich mich der Einfachheit wegen jedoch für Ransis Code entschieden. Für Deine Alternativen bin ich jedoch immer sehr aufgeschlossen und dankbar :-)
Die "Late binding"-Alternative (Sub Rein()) hatte ich zuvor auch schon getestet, sie funktioniert auf PC2 allerdings nicht (das gleiche Resultat wie mit "Early binding" : Es werden nur 2 (erweiterte) Sonderzeichen in die Zwischenablage kopiert : xEF xBF xBF xEF xBF xBF (also : CHR(239) & CHR(191) & CHR(191) & CHR(239) & CHR(191) & CHR(191)).
Vielen Dank nochmals an alle,
Salut und schönen Tag, NoNet

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Datumswerte auslesen"