Office-Zwischenablage mit VBA löschen

    • VBA: Excel

      Office-Zwischenablage mit VBA löschen

      Hallo liebe Community,

      es gibt ja eine Office-Zwischenablage, in der die kopierte Informationen abgelegt werden.

      Jetzt gibt es bei mir(nicht mehr) täglich mehrmals eine Fehlermeldung die heißt 'Kann die Zwischenablage nicht leeren', unabhängig davon, ob in der Office-Zwischenablage etwas drin ist oder nicht.
      Das nervt unheimlich, wenn Sie ein Makro, das Kopieren-Einfügen -Funktionen beinhaltet, im Hintergrund laufen lassen haben und das jedes Mal sein Dienst quittiert, weil die Office-Zwischenablage angeblich voll ist.
      Meine Recherchen im Internet brachten mich nicht so weit, um das Problem mit VBA zu lösen. Nun habe ich doch im Internet ein VBA-Makro gefunden, das für Excel 2003-2007 geschrieben war.
      Den Code habe ich modifiziert und angepasst sodass unter Excel 2010 (deutsche Version) 32bit und 64bit laufen kann.
      Wer Interesse hat oder probieren will, kann den Quelcode kopieren und in einem allgemeinen Modul einfügen.

      Vie Spaß damit

      Spoiler anzeigen

      Visual Basic-Quellcode

      1. 'Code
      2. Option Explicit
      4. #If VBA7 And Win64 Then
      6. Private Declare PtrSafe Function FindWindowEx Lib "USER32" _
      7. Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
      8. ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
      11. Private Declare PtrSafe Function PostMessage Lib "USER32" Alias "PostMessageA" _
      12. (ByVal hwnd As LongPtr, ByVal wMsg As Long, _
      13. ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
      16. Private Declare PtrSafe Function apiOpenClipboard Lib _
      17. "USER32" Alias "OpenClipboard" (ByVal hwnd As LongPtr) As Long
      19. Private Declare PtrSafe Function apiEmptyClipboard Lib _
      20. "USER32" Alias "EmptyClipboard" () As Long
      23. Private Declare PtrSafe Function apiCloseClipboard Lib _
      24. "USER32" Alias "CloseClipboard" () As Long
      26. Private Declare PtrSafe Sub Sleep Lib _
      27. "kernel32.dll" (ByVal dwMilliseconds As Long)
      30. #Else
      33. Private Declare Function apiOpenClipboard Lib _
      34. "USER32" Alias "OpenClipboard" (ByVal hwnd As Long) As Long
      36. Private Declare Function apiEmptyClipboard Lib _
      37. "USER32" Alias "EmptyClipboard" () As Long
      39. Private Declare Function apiCloseClipboard Lib _
      40. "USER32" Alias "CloseClipboard" () As Long
      42. Private Declare Sub Sleep Lib _
      43. "kernel32.dll" (ByVal dwMilliseconds As Long)
      45. Private Declare Function FindWindowEx Lib _
      46. "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, _
      47. ByVal hWnd2 As Long, ByVal lpsz1 As String, _
      48. ByVal lpsz2 As String) As Long
      50. Private Declare Function PostMessage Lib _
      51. "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
      52. ByVal wParam As Long, ByVal lParam As Long) As Long
      54. #End If
      56. Private Const WM_LBUTTONDOWN As Long = &H201&
      57. Private Const WM_LBUTTONUP As Long = &H202&
      60. Private Function MakeLong(ByVal nLoWord As Integer, ByVal nHiWord As Integer) As Long
      61. MakeLong = nHiWord * 65536 + nLoWord
      62. End Function
      66. Sub ClearOfficeClipboard()
      68. #If VBA7 And Win64 Then
      69. Dim hMain As LongPtr, hExcel2 As LongPtr, hClip As LongPtr, hWindow As LongPtr, hParent As LongPtr
      70. Dim lParameter As Long, sTask$
      72. #Else
      74. Dim hMain As Long, hExcel2 As Long, hClip As Long, hWindow As Long, hParent As Long
      75. Dim lParameter As Long, sTask$
      77. #End If
      79. Dim ocbShow As Boolean
      81. sTask = Application.CommandBars("Office Clipboard").NameLocal
      83. ocbShow = Application.CommandBars("Office Clipboard").Visible
      85. 'Office-Zwischenablage muss sichtbar sein
      86. If Not Application.CommandBars("Office Clipboard").Visible = True Then
      87. Application.CommandBars("Office Clipboard").Visible = True
      88. End If
      90. Application.ActiveWindow.Activate
      92. Application.ScreenUpdating = False
      93. Application.ScreenUpdating = True
      94. Sleep (1000)
      95. ' Handle for XLMAIN
      96. hMain = Application.hwnd
      98. 'finden OfficeClipboard Fenster
      99. '2 Methoden, da wir nicht sicher sind, ob es sichtbar ist
      100. 'Sobald es sichtbar gemacht wird, wird WindowClass erstellt
      101. 'Und bleibt für die Dauer der Instanz geladen
      103. Do
      104. hExcel2 = FindWindowEx(hMain, hExcel2, "EXCEL2", vbNullString)
      105. hParent = hExcel2: hWindow = 0
      106. hWindow = FindWindowEx(hParent, 0, "MsoCommandBar", sTask)
      107. If hWindow Then
      108. hParent = hWindow: hWindow = 0
      109. hWindow = FindWindowEx(hParent, 0, "MsoWorkPane", vbNullString)
      110. If hWindow Then
      111. hParent = hWindow: hWindow = 0
      112. hClip = FindWindowEx(hParent, 0, "bosa_sdm_XL9", vbNullString)
      113. If hClip > 0 Then
      114. Exit Do
      115. End If
      116. End If
      117. End If
      118. Loop While hExcel2 > 0
      120. If hClip = 0 Then
      121. hParent = hMain: hWindow = 0
      122. hWindow = FindWindowEx(hParent, 0, "MsoWorkPane", vbNullString)
      123. If hWindow Then
      124. hParent = hWindow: hWindow = 0
      125. hClip = FindWindowEx(hParent, 0, "bosa_sdm_XL9", vbNullString)
      126. End If
      127. End If
      129. If hClip = 0 Then
      130. Call ClipWindowForce
      131. hParent = hMain: hWindow = 0
      132. hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", vbNullString)
      133. If hWindow Then
      134. hParent = hWindow: hWindow = 0
      135. hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", vbNullString)
      136. End If
      137. End If
      139. If hClip = 0 Then
      140. MsgBox "Kann das Fenster von Zwischwnablage nicht finden."
      141. Application.CommandBars("Office Clipboard").Visible = ocbShow
      142. Application.ScreenUpdating = True
      143. Exit Sub
      144. End If
      146. lParameter = MakeLong(120, 18)
      147. Call PostMessage(hClip, WM_LBUTTONDOWN, 0&, lParameter)
      148. Call PostMessage(hClip, WM_LBUTTONUP, 0&, lParameter)
      149. DoEvents
      151. 'Ursprung wiederherstellen
      152. Application.CommandBars("Office Clipboard").Visible = ocbShow
      153. Application.ScreenUpdating = True
      154. MsgBox "Office-Zwischenablage entleert!"
      156. End Sub
      158. '?????? bis jetzt brauchte ich das nicht
      159. Sub ClipWindowForce()
      160. Dim octl
      161. With Application.CommandBars("Office Clipboard")
      162. If Not .Visible Then
      163. Application.ScreenUpdating = False
      164. Set octl = Application.CommandBars(1).FindControl(ID:=809, recursive:=True)
      165. If Not octl Is Nothing Then octl.Execute
      166. '.Visible = False
      167. Application.ScreenUpdating = True
      168. End If
      169. End With
      170. End Sub
      174. Sub mach_endlich_mit_der_schei_schluss()
      176. Call ClearOfficeClipboard
      177. 'Call apiOpenClipboard(0) 'Windows-Zwischenablage
      178. 'apiEmptyClipboard 'Windows-Zwischenablage
      179. 'apiCloseClipboard 'Windows-Zwischenablage
      180. Application.CutCopyMode = False
      182. End Sub


      Edit by hal2000:
      - Expander und Code-Tags eingefügt.

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „hal2000“ ()