Event wird nicht zweites Mal ausgeführt
16.08.2022 09:59:43
CoAdmiral
es geht bei mir um eine Datei, die wir für die Erstellung einer Kundenabrechnung verwenden. Ich habe im Menüsheet ("Steuerung") eine ActiveX-CheckBox eingfügt. Wird diese angeklickt, soll ein Storno-Beleg erstellt werden. Im Hintergrund macht er auch alles (Anpassung von Beträgen und Text). Was jedoch nur einmal klappt: mit dem Klick soll die aktive Excel-Datei als separate Datei (mit Namenszusatz "_Storno") abgespeichert werden. Würde ich den Vorgang wiederholen macht er zwar die Anpassung bei Text und Co., aber die Datei wird nicht separat gespeichert. Erst wenn ich wieder alles schließe und dann besagte Datei öffne und den Storno-Befehl anklicke, klappt es wieder. Ob ich mehrere Dateien offen habe oder nicht, spielt wohl keine Rolle.
Der Code ist unter "DieseArbeitsmappe" geschrieben:
Option Explicit
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim wsSteuerung, wsGS As Worksheet
Dim wb As Workbook
Dim FileOnly As String
Dim a As Variant
Set wb = ThisWorkbook
FileOnly = ThisWorkbook.Name
FileOnly = Left(FileOnly, Len(FileOnly) - 5)
Set wsSteuerung = wb.Worksheets("Steuerung")
Set wsGS = wb.Worksheets("GS")
On Error GoTo ErrorHandler
Application.EnableEvents = False
If Sh.Name = wsSteuerung.Name Then
If boolStorno = True Then
a = wsGS.Range("RG_01_alt") & "-S"
wsGS.Range("RG_01_alt").Copy
wsGS.Range("RG_01_alt").Offset(1, 0).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsGS.Range("RG_01_alt") = a
Application.CutCopyMode = False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=wb.Worksheets("Steuerung").Range("Zielpfad") & "\" & FileOnly & "_Storno.xlsb"
Application.DisplayAlerts = True
Exit Sub
End If
End If
ErrorHandler:
Application.EnableEvents = True
End Sub
Private Sub StornoCheckBox_Click()
If StornoCheckBox.Value = True Then
boolStorno = True
Application.Calculate
Else
ThisWorkbook.Worksheets("GS").Range("RG_01_alt").Offset(1, 0).ClearContents
boolStorno = False
End If
End Sub