Zwischenablage per VBA automatisch löschen (Excel 2013 32 bit)
#1
Hallo Zusammen,
 
gibt es eine Möglichkeit die Zwischenablage in Excel 2013 (32 bit) automatisch nach jeder Aktion zu löschen per Mako?
 
Danke schon mal für eure Hilfe und bleibt gesund.
Antworten Top
#2
Hallo Dietmar,

mit diesem Code kannst Du die Zwischenablage leeren.

Code:

' In ein Tabellenmodul
Private Sub Worksheet_Change(ByVal Target As Range)
  LoescheZwischenablage
End Sub


' In ein Modul
Option Explicit

Private Declare PtrSafe Function OpenClipboard Lib "user32" ( _
        ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr

Function LoescheZwischenablage()
    OpenClipboard 0&
    EmptyClipboard
    CloseClipboard
End Function

_________
viele Grüße
Karl-Heinz
Antworten Top
#3
Hallo

ich weiss nicht ob es noch einfacher geht.  Prbiere es einfach mal aus.  Kopiere eine leere Zelle und füge in dieselbe Zelle den Wert wieder ein.
"Heisse Luft", denn in Wahrheit wirdf nix kopiert.  Eine Luftnummer.  Aber der Zwischenspeicher ist leer!

Sub test()
  Range("A1").Copy Range("A1")
End Sub


mfg Gast 123

PS  Der bessere Fachmann ist Karl-Heinz, da sieht man sein fachliches Wissen. Weil ich den Code nicht beherrsche habe ich es anders probiert!
Antworten Top
#4
Hallo Volti,

danke für deine Hilfe.

Leider funktioniert es bei mir nicht.
Die Datei zeigt beim aktivieren immer das an (siehe Anhang).

Kannst du mir evtl. sagen, was ich falsch gemacht habe?


Angehängte Dateien
.pdf   Dok1.pdf (Größe: 217,08 KB / Downloads: 8)
Antworten Top
#5
Hallo,

wie schon geschrieben gehört in ein Modul nur:

Code:

Option Explicit

Private Declare PtrSafe Function OpenClipboard Lib "user32" ( _
        ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr

Function LoescheZwischenablage()
    OpenClipboard 0&
    EmptyClipboard
    CloseClipboard
End Function


und nix davor...
Wie kommst Du darauf, das in eine Sub Makro1 zu packen?

Der andere Code gehört, wenn gewünscht, in das betreffende Tabellenmodul.

Gruß KH
Antworten Top
#6
Hallo Volti,

danke erstmal für deine Hilfe.

Deine Funktion bzw. dein Modul funktioniert.
Beim Öffnen der Excel-Tabelle ist die Zwischenablage immer leer.

Zu deiner Frage, warum ich das in einen Sub einbauen wollte hat folgenden grund:

Meine Excel-Tabelle stürzt unreglmäßig immer mal ab, wenn die Zwischenablage zu voll ist.

Somit war meine Idee beim Aktivieren der vorhandenen Makros Ihm auch gleich zu sagen, dass er die Zwischenablage leer machen soll.
Damit die Excel Stabiler läuft.

Folgende beide Makros werden mit einen Button regelmäßig aktiviert.
Kann man da eine Zwischenablage Löschung einbauen?

Erste Makro:

Sub Sektion_Einfuegen()
ActiveSheet.Outline.ShowLevels RowLevels:=2
Dim merkZelle As Range
Set merkZelle = ActiveCell
If ActiveCell.Borders(xlEdgeTop).LineStyle <> 1 Then
MsgBox "Bitte an der unteren dicken Linie einer Sektion!"
Exit Sub
End If
If ActiveCell.Column <> 1 Then
MsgBox "Bitte richtige Zeile auswählen in Spalte A!"
Exit Sub
End If

    Sheets("Vorlage").Select
    Range("A5:AF15").Select
    Selection.Copy
    Sheets("Kalkulation").Select
    ActiveCell.Select
    Selection.Insert Shift:=xlDown
    ActiveCell.Select
Dim bereich As Range
Dim c As Range
Range(ActiveCell.Offset(1, 20), ActiveCell.Offset(10, 20)).Select
For Each c In Selection.Cells
    With c
        .Formula = Replace(c.Formula, "(P", "($P$")
        .Formula = Replace(c.Formula, "-Q", "-$Q$")
        .Formula = Replace(c.Formula, "/I", "/$I$")
    End With
Next c

    merkZelle.Activate  'wiederaufsetzZelle
End Sub


Zweite Makro:

Sub Zeile_Einfuegen()
  Dim lngV1 As Long, lngV2 As Long, lngV3 As Long
  With ActiveCell.EntireRow
    If .Row > 9 Then
      If .Cells(1, 9).HasFormula Then
        lngV1 = -1
        lngV2 = -1
        lngV3 = -1
      ElseIf Cells(.Row - 1, 9).HasFormula Then
        lngV1 = 0
        lngV2 = 1
        lngV3 = 0
      ElseIf .Cells(1, 8).HasFormula Then
        lngV1 = 0
        lngV2 = 0
        lngV3 = -1
      End If
      .Offset(lngV1).Copy
      .Offset(lngV2).Insert
      Cells(.Row + lngV3, 3).Value = "neue Position"
      Application.CutCopyMode = False
    End If
  End With
End Sub
Antworten Top
#7
Hallo Dietmar,

Du kannst von überall und aus jedem Makro die Function nutzen, indem Du sie einfach aufrufst.

Call LoescheZwischenablage.

Oder, wenn es Dir lieber ist, kannst Du auch einfach die drei API-Call in Deine Subs einbauen.

Sub Sektion_Einfuegen()
' Dein Code
OpenClipboard 0&
EmptyClipboard
CloseClipboard

' Dein Code
End Sub

Gruß Karl-Heinz
Antworten Top
#8
Hallo Volti,

danke für deine Hilfe.

Es funktioniert bei mir leider nicht, es kommt immer eine Fehler (siehe Anhang).

Kannst du mir bitte deinen vorgeschlagenen Code in einer der beiden Makros einfügen.
Damit ich sehen kann, wie ich es machen muss.
Also wie der Code eingebaut werden kann.

Danke nochmal für die Hilfe.


Angehängte Dateien
.pdf   Dok1.pdf (Größe: 269,96 KB / Downloads: 2)
Antworten Top
#9
Hallo Dietmar,

die Declares müssen im gleichen Modul sein wie die Call-Aufrufe und als erstes stehen, da sie Private deklariert sind.

Aber am besten machst Du sie Public, dann kann man die Funktionen von überall aufrufen.

Ansonsten hast Du es schon richtig gemacht.

Jetzt sollte es klappen.

Public Declare PtrSafe Function OpenClipboard Lib "user32" ( _
         ByVal hwnd As LongPtr) As LongPtr
Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPtr
Public Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr



Gruß
Karl-Heinz
Antworten Top
#10
Hallo Volti,

es tut mir leid, ich bin anscheindend zu blöd dafür.

Es funktioniert bei mir leider nicht (siehe PDF im Anhang).

Ich glaube es ist sinvoll, wenn ich dir die Excel-Datei mal schicke und du dir das evtl. mal anschen kannst (siehe Anhang Excelvorlage).

Es wäre total cool, wenn du in der Excel die Löschung der Zwischenablage nach aktivieren der jeweiligen 3 Makros einarbeitetn könntest
und du mir dann die Excel wieder zurückschicken könntest.

Danke für deine Hilfe und nochmal sorry das ich zu blöd dafür bin.

Und 1000 dank nochmal für deine Zeit.

mfg

Dietmar


Angehängte Dateien
.xlsm   Excelvorlage.xlsm (Größe: 54,45 KB / Downloads: 2)
.pdf   Dok1.pdf (Größe: 308,93 KB / Downloads: 2)
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste