Neues Makro in ein vorhandenes integrieren
04.04.2026 04:40:06
Ringberger
ich habe zwei Makro's. Das Erste (Übertrag_von_Buchung_zu_Beleg) erkennt im Tabellenblatt ob es sich um eine normale (Kassen)Buchung (eine Zeile), Umbuchung (zwei Zeilen) oder Splitt-Buchung (bis zu 16 Zeilen) handelt, sammelt die Daten der entsprechenden Zeilen und überträgt diese zum entsprechenden Beleg.
Das zweite Makro (Splittbuchungsbetrag_eingeben) öffnet eine Inputbox, wo der Betrag eingegeben wird, mit dem die Summe der Splittzeilen verglichen/kontrolliert werden soll.
Jedes Makro für sich funktioniert ohne Fehler. Nur wenn ich versuche, das zweite Makro an der aus meiner Sicht passende Stelle einzubauen, passiert nichts mehr.
Ziel ist es: Wenn die MsgBox "Soll der Beleg für die Splittbuchung geöffnet werden?" geöffnet ist, soll anschließend beim Klick auf "Ja" sich die Inputbox öffnen, um den Betrag einzugeben. Nach Klick auf OK wird der eingegeben Betrag in einer definierte Zelle gespeichert. Danach wird Makro 1 wie gewohnt weiter abgearbeitet.
'================================================================================
' HAUPT-SUB: Übertrag_Von_Buchung_Zu_Beleg
'================================================================================
Public Sub Übertrag_Von_Buchung_Zu_Beleg()
Dim btnName As String
Dim btnRow As Long
Dim indexSheet As Integer
Dim buchArt As String
Dim belegNr As Long
Dim gKonto As Long
Dim sKonto As String
Dim buchText As String
Dim einnahme As Double
Dim ausgabe As Double
Dim dataSheet As Worksheet
Dim result As VbMsgBoxResult
' Caller-Name ermitteln (MacOS-kompatibel)
On Error Resume Next
btnName = Application.Caller
On Error GoTo 0
If btnName = "" Then
MsgBox "Dieses Makro muss über einen Button aufgerufen werden.", _
vbExclamation, "Fehler"
Exit Sub
End If
Set dataSheet = ActiveSheet
indexSheet = dataSheet.index
' Button-Zeile ermitteln
On Error Resume Next
btnRow = dataSheet.Shapes(btnName).TopLeftCell.Row
On Error GoTo 0
If btnRow = 0 Then
MsgBox "Button-Position konnte nicht ermittelt werden.", _
vbExclamation, "Fehler"
Exit Sub
End If
' Eingabe validieren
If Not EingabeValidieren(btnRow) Then Exit Sub
' Buchungsdaten lesen
With dataSheet
buchArt = .Range("A" & btnRow).Value
belegNr = CLng(.Range("C" & btnRow).Value)
gKonto = CLng(.Range("D" & btnRow).Value)
sKonto = .Range("E" & btnRow).Value
buchText = .Range("F" & btnRow).Value
einnahme = .Range("G" & btnRow).Value
ausgabe = .Range("H" & btnRow).Value
End With
'===========================================================================
' Buchungsart auswerten
'===========================================================================
' --- UMBUCHUNG ---
If UCase(buchArt) = "U" Then
result = MsgBox("Soll der Beleg für die Umbuchung geöffnet werden?", _
vbQuestion + vbYesNoCancel, "Umbuchung erkannt")
Select Case result
Case vbYes
Call ErstelleUmbuchungsBeleg(dataSheet, belegNr, btnRow, indexSheet)
Case vbNo
' Normalen Beleg erstellen (weiter unten)
Case vbCancel
Exit Sub
End Select
Exit Sub
End If
' --- SPLITTBUCHUNG ---
If IsNumeric(buchArt) Then
If CDbl(buchArt) > 0 Then
result = MsgBox("Soll der Beleg für die Splittbuchung geöffnet werden?", _
vbQuestion + vbYesNoCancel, "Splittbuchung erkannt")
Select Case result
Case vbYes
Call ErstelleSplittBeleg(dataSheet, belegNr, btnRow, indexSheet)
Case vbNo
' Normalen Beleg erstellen (weiter unten)
Case vbCancel
Exit Sub
End Select
Exit Sub
Else
MsgBox "Für Splittbuchungen nur Zahlen größer 0 verwenden!", _
vbExclamation, "Fehler Buchungsart"
Exit Sub
End If
End If
Beispieldatei mit Makro 2: https://www.herber.de/bbs/user/180479.xlsm
Ich hoffe ich war verständlich und meine Angaben sind ausreichend um mir vielleicht helfen zu können.
Vielen, vielen Dank schon einmal
Andreas
Anzeige