Thema Datum  Von Nutzer Rating
Antwort
22.10.2020 16:16:58 Ole
NotSolved
22.10.2020 16:37:00 volti
*****
Solved
22.10.2020 17:23:06 Ole
NotSolved
Blau String in Zwischenablage kopieren
22.10.2020 17:36:24 volti
*****
NotSolved
22.10.2020 17:58:48 Ole
NotSolved

Ansicht des Beitrags:
Von:
volti
Datum:
22.10.2020 17:36:24
Views:
758
Rating: Antwort:
  Ja
Thema:
String in Zwischenablage kopieren

Hallo Ole, 

nachfolgender code sollte auch unter Win7 32 Bit laufen...

Bei den neueren Excel kommt VBA7 zum Tragen, das sowohl als 32 Bit wie auch als 64 Bit betrieben werden können. Deshalb passen die Declares auch für 32 Bit (VBA7)

Das alte Excel arbeitet mit VBA6, hier müssen die alten Declares angewendet werden. Insbesondere gibt es hier kein PtrSafe und alle Handle sind Long statt LongPtr.

 

Option Explicit
   
#If VBA7 Then
 Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
         ByVal dwBytes As LongPtr) As LongPtr
 Private Declare PtrSafe Function GlobalLock 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 SetClipboardData Lib "user32" (ByVal wFormat As Long, _
         ByVal hMem As LongPtr) 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
 
 Dim hMem As LongPtr, lpGMem As LongPtr

#Else

 Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
         ByVal dwBytes As Long) As Long
 Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
 Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
 Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
         ByVal lpString2 As Any) As Long
 Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, _
         ByVal hMem As Long) As Long
 Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
 Private Declare Function CloseClipboard Lib "user32" () As Long
 Private Declare Function EmptyClipboard Lib "user32" () As Long
 
 Dim hMem As Long, lpGMem As Long

#End If

   
Function KopiereinClpbrd(Optional ClpTxt As String) As String
'Kopieren über die API (alternativ)
 hMem = GlobalAlloc(&H42, Len(ClpTxt) + 1)
 lpGMem = GlobalLock(hMem)
 lpGMem = lstrcpy(lpGMem, ClpTxt)
 If GlobalUnlock(hMem) = 0 Then
    If OpenClipboard(0&) <> 0 Then
       EmptyClipboard
       SetClipboardData 1, hMem  '1=CF_TEXT
       CloseClipboard
    End If
 End If
  
End Function
 
Sub Copytest()
 KopiereinClpbrd "Teste mich"
End Sub

viele Grüße

Karl-Heinz


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
22.10.2020 16:16:58 Ole
NotSolved
22.10.2020 16:37:00 volti
*****
Solved
22.10.2020 17:23:06 Ole
NotSolved
Blau String in Zwischenablage kopieren
22.10.2020 17:36:24 volti
*****
NotSolved
22.10.2020 17:58:48 Ole
NotSolved