Problem mit DataObject.PutInClipboard

Hallo zusammen
Mit diesem Problem schlage ich mich gestern + heute bereits fast den ganzen Tag herum und bekomme es einfach nicht gelöst. Ich verwende ein relativ aufwendiges Excel - Tool für die Verwaltung von Warenein- und -ausgängen, bestehend aus 12 Tabellenblättern als Datenbanken, 2 UserForms als Benutzeroberfläche und 2 Modulen für allgemeine Funktionen wie zB UF Aufruf. Funktioniert auch alles einwandfrei. Bis hier hin also nur zur Info.
Das Tool kopiert u.a. einen String in die WIN Zwischenablage, damit dieser Text anschliessend in einer Weboberfläche weiter verwendet werden kann. Und genau das funktioniert jetzt auf einmal nicht mehr.
Mit folgender Methode wird der Text ins Clipboard kopiert:


Option Explicit
Public Sub CopyToCB()
Dim oData As New DataObject
Dim sText As String
sText = "Dieser Text soll in die Zwischenablage kopiert werden"
With oData
.SetText sText
.PutInClipboard
End With
End Sub

Nachdem ich nun unendlich viele Varianten durchgetestet und versucht habe, einen logischen Zusammenhang zu eruieren, stehe ich an folgendem Punkt und weiss echt nicht mehr weiter. Ich habe aus der Datei sämtliche Tabellen und die beiden Module gelöscht. Anschliessend habe ich ein neues Modul angelegt und den o.g. Code eingefügt. Code funktioniert nicht. Dann habe ich erst die eine, dann die andere UserForm entfernt (vorher exportiert). Sind beide UserForms aus dem Projekt entfernt, funktioniert der Code wieder. Importiere ich eine der UserForms (egal welche) wieder, funktioniert der Code nicht mehr. Läuft durch, String wird aber nicht ins CB kopiert. Stattdessen hat er nicht zu interpretierende Zeichen als Inhalt (Editor zeigt beim Einfügen gar nichts, Notepad++ zeigt xEFxBFxBFxEFxBFxBF, Google Sucheingabe zeigt �� (2 schwarze Rauten mit je einem Fragezeichen).
Verweis auf Microsoft Forms 2.0 Objekt Library ist immer gleich gesetzt (C:\WINDOWS\SysWOW64\FM20.DLL). Führe ich die Datei auf einem anderen Rechner aus, funktioniert alles ohne Probleme. Zur Info: Microsoft Office Home and Business 2016 auf WIN10 Pro. Wenn gewünscht kann ich die abgespeckte Datei mal posten, bei Euch wird sie aber auch funktionieren...
Hat jemand im Moment das gleiche Problem oder schon mal davon gehört?
Was würdet Ihr als nächstes machen?
Vielen Dank und Gruss, Henner

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub CopyToCB() Dim oData As DataObject Dim sText As String sText = "Dieser Text soll in die Zwischenablage kopiert werden" Set oData = New DataObject With oData .SetText sText .PutInClipboard End With End Sub

Option Explicit Public Sub CopyToCB() Dim oData As DataObject Dim sText As String sText = "Dieser Text soll in die Zwischenablage kopiert werden" Set oData = New DataObject With oData .SetText sText .PutInClipboard End With End Sub

Hallo Henner,
das Problem besteht neuerdings temporär z.B. unter Win10. Ich habe derzeit mit u.a. code kein Problem mehr:

Sub KopieInDieZwischenablage()

'Ohne Verweis Microsoft Forms 2.X

 With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

   .SetText "Dieser Text soll in die Zwischenablage kopiert werden"

   .PutInClipboard

 End With

End Sub

Falls das nicht hilft, habe ich in anderen Foren folgendes zur Behebung gelesen:
Alle Explorerfenster schließen - also diese "gelben Ordnersymbole in der Statusleiste".
Oder Du greift auf die gute alte API zurück, das sollte auf jeden Fall auch ohne o.a. Maßnahme funktionieren:

Option Explicit

Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr

Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr

Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr

Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr

Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long

Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr

Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long

Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr

Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr

Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long

Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long

Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long

Sub TestKopieInAusZwis()

 KopieInZwischenablageAPI "Dieser Text soll in die Zwischenablage kopiert werden"

End Sub

Sub KopieInZwischenablageAPI(ClipText As String)

'Kopieren über die API

 Dim hGlobal As LongPtr, lpGMem As LongPtr

 hGlobal = GlobalAlloc(&H42, Len(ClipText) + 1)

 lpGMem = GlobalLock(hGlobal)

 lpGMem = lstrcpy(lpGMem, ClipText)

 If GlobalUnlock(hGlobal) = 0 Then

  If OpenClipboard(0&) &LT;&GT; 0 Then

   EmptyClipboard

   SetClipboardData 1, hGlobal  '=CF_TEXT

   CloseClipboard

  End If

 End If

 GlobalFree hGlobal

End Sub

viele Grüße
Karl-Heinz

Beliebteste Forumthreads (12 Monate)

Problem mit DataObject.PutInClipboard

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

139 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Problem mit DataObject.PutInClipboard

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

139 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread