PutInClipboard

Herbert_Grom · 2022-08-05T11:57:32+00:00

Hallo, habt ihr evtl. eine Idee, warum der folgende Code bei mir nur das Ergebnis des Bildes ergibt, wenn ich den Clipboardinhalt in eine eMail oder einen Notepad-Text einfügen will? Den Verweis "...2.0 Object Library" habe ich gesetzt. Sub kopieren() Dim objClip As DataObject, sTmp$ Set objClip = New DataObject sTmp = Tabelle2.Cells(1, 1).Value objClip.SetText sTmp objClip.PutInClipboard End Sub [Bild: Userbild] In Tabelle2.cells(1,1) steht dieser Text: "Hallo Horst, kannst Du mir bitte ... ... Für eine kurze Bestätigung wäre ich Dir dankbar! Dann bis Dienstag. Viele Grüße Herbert" Servus

Option Explicit


Public Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long

Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Public Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long

Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Function ClipBoard_SetData(MyString As String)
   Dim hGlobalMemory As Long, lpGlobalMemory As Long
   Dim hClipMemory As Long, X As Long

   ' Allocate moveable global memory. 
   '------------------------------------------- 
   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

   ' Lock the block to get a far pointer 
   ' to this memory. 
   lpGlobalMemory = GlobalLock(hGlobalMemory)

   ' Copy the string to this global memory. 
   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

   ' Unlock the memory. 
   If GlobalUnlock(hGlobalMemory) <> 0 Then
      MsgBox "Could not unlock memory location. Copy aborted."
      GoTo OutOfHere2
   End If

   ' Open the Clipboard to copy data to. 
   If OpenClipboard(0&) = 0 Then
      MsgBox "Could not open the Clipboard. Copy aborted."
      Exit Function
   End If

   ' Clear the Clipboard. 
   X = EmptyClipboard()

   ' Copy the data to the Clipboard. 
   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:

   If CloseClipboard() = 0 Then
      MsgBox "Could not close Clipboard."
   End If

End Function

Sub SteTEst()
  Call ClipBoard_SetData(Range("A1").Value)
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002 und höher (32-bit) und Microsoft 365 (32-bit Desktop-Version)
In VBA geschrieben von Lukas Mosimann. Projektbetreuung: René Holtz

Code erstellt und getestet in Microsoft 365 - 32-bit Desktopversion
Codedarstellung mit VBAHTML 01.2022 erstellt.

Forumthread: PutInClipboard

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Problemlösung für PutInClipboard in Excel VBA

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)