Zwischenablage wird gelöscht (Kopierfokus)

Hallo zusammen,
es gibt ja schon einige Beiträge darüber, dass bei bestimmten Aktionen (z.B. DisplayStatusBar, Objekt.visible, Object.Enabled etc.) die Zwischenablage geleert wird, und es gibt auch Workarounds dafür. Sie basieren allerdings darauf, dass der selektierte (= zu kopierende) Bereich ("Selection") gespeichert wird. (https://www.herber.de/forum/archiv/1160to1164/1162669_Excel_Zwischenablage_ist_gleich_wieder_weg.html oder
https://www.herber.de/forum/archiv/1252to1256/1253821_Zwischenablage_loescht_sich_bei_visible_true.html)
Bei mir soll ein Bereich von einer beliebigen anderen Tabelle hierher kopiert werden. In der _ Zieltabelle sorgt ein


ActiveSheet.Buttons("BTN1").Enabled = True

dafür, dass die Zwischenablage geleert wird. An dieser Stelle hilft mir die "Selection" aber nicht weiter, denn es ist ja bereits eine andere Tabelle aktiv als die, in der sich der zu kopierende Bereich befindet.
Hat irgend jemand eine Idee, wie ich trotzdem den Inhalt der Zwischenablage behalten bzw. wiederherstellen kann?
Vielen Dank schon mal.
Burkhard

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zwischenablage wird gelöscht (Kopierfokus)

04.05.2018 14:40:02

Peter(silie)

Nachtrag:

04.05.2018 14:45:32

Peter(silie)

AW: Nachtrag:

04.05.2018 15:42:53

Burkhard

AW: Nachtrag:

04.05.2018 16:10:47

Peter(silie)

ich werd's ausprobieren

04.05.2018 17:04:45

Burkhard

AW: ich hab's ausprobiert

07.05.2018 12:58:58

Burkhard

Hallo,
versuch mal die Daten gleich ins clipboard zu jagen:
Irgendein Copy Code:

Sub a()
Dim r
With Me
Set r = .Range(.Cells(3882, 9), .Cells(1000, 9))
Dim tmp
tmp = Join(Application.Transpose(r.Value2), ";")
Clipboard_.SetClipboard (tmp)
Debug.Print Clipboard_.GetClipboard
End With
End Sub

Modul Clipboard_

Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As  _
Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) 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 GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long,  _
ByVal lpString2 As Long) As Long
Public Sub SetClipboard(sUniText As String)
Dim iStrPtr As Long
Dim iLen As Long
Dim iLock As Long
Const GMEM_MOVEABLE As Long = &H2
Const GMEM_ZEROINIT As Long = &H40
Const CF_UNICODETEXT As Long = &HD
OpenClipboard 0&
EmptyClipboard
iLen = LenB(sUniText) + 2&
iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
iLock = GlobalLock(iStrPtr)
lstrcpy iLock, StrPtr(sUniText)
GlobalUnlock iStrPtr
SetClipboardData CF_UNICODETEXT, iStrPtr
CloseClipboard
End Sub
Public Function GetClipboard() As String
Dim iStrPtr As Long
Dim iLen As Long
Dim iLock As Long
Dim sUniText As String
Const CF_UNICODETEXT As Long = 13&
OpenClipboard 0&
If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
iStrPtr = GetClipboardData(CF_UNICODETEXT)
If iStrPtr Then
iLock = GlobalLock(iStrPtr)
iLen = GlobalSize(iStrPtr)
sUniText = String$(iLen \ 2& - 1&, vbNullChar)
lstrcpy StrPtr(sUniText), iLock
GlobalUnlock iStrPtr
End If
GetClipboard = sUniText
End If
CloseClipboard
End Function

Sub SaveClipboardText() Dim sText As String sText = GetTextFromClipboard WriteTextToClipboard (sText) End Sub Function GetTextFromClipboard() As String Dim oData As New DataObject On Error Resume Next oData.GetFromClipboard GetTextFromClipboard = oData.GetText End Function Sub WriteTextToClipboard(sText As String) Dim oData As New DataObject With oData .SetText sText .PutInClipboard End With End Sub

Beliebteste Forumthreads (12 Monate)

Zwischenablage wird gelöscht (Kopierfokus)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread