AW: Der Fehler liegt im fehlenden Code! (owT)
12.07.2020 16:00:46
Dominik
Private Sub Worksheet_Change(ByVal Target As Range)
With Worksheets("POS_A2")
If Target.Address = "$R$22" Then
Dim Bediener As Range
Set Bediener = Worksheets("Mitarbeiterstamm").Columns(7).Find(what:=Worksheets("POS_A2"). _
Range("R22").Value, _
lookat:=xlWhole)
If Not Bediener Is Nothing Then
If Worksheets("Mitarbeiterstamm").Range("F" & Bediener.Row).Value = "JA" Then
'Bonabbruch
If .Range("R23").Value = "Bonabbruch" Then GoTo Bonabbruch
'Bonstorno
If .Range("R23").Value = "Bonstorno" Then GoTo Bonstorno
'Retoure
If .Range("R23").Value = "Retoure" Then GoTo Retoure
'Parken
If .Range("R23").Value = "Parken" Then GoTo Parken
'Backoffice
If .Range("R23").Value = "Backoffice" Then GoTo Backoffice
'Wechselgeldzuteilung
If .Range("R23").Value = "Wechselgeldzuteilung" Then GoTo Wechselgeldzuteilung
'Bonabbruch
Bonabbruch:
Dim ?ber As Long
?ber = Worksheets("Autorisierungs?bersicht").Range("A99999").End(xlUp).Row + 1
'Autorisierungs?bersicht
'Bediener
Worksheets("Autorisierungs?bersicht").Range("A" & ?ber).Value = Worksheets(" _
POS_Erfassung").Range("D3").Value
'Name
Dim Bediener2 As Range
Set Bediener2 = Worksheets("Mitarbeiterstamm").Columns(4).Find(what:=Worksheets(" _
Autorisierungs?bersicht").Range("A" & ?ber).Value, _
lookat:=xlWhole)
If Not Bediener2 Is Nothing Then
Worksheets("Autorisierungs?bersicht").Range("B" & ?ber).Value = Worksheets(" _
Mitarbeiterstamm").Range("C" & Bediener2.Row).Value & "," & " " & Worksheets("Mitarbeiterstamm").Range("B" & Bediener2.Row).Value
End If
'Datum
Worksheets("Autorisierungs?bersicht").Range("C" & ?ber).Value = Date
'Uhrzeit
Worksheets("Autorisierungs?bersicht").Range("D" & ?ber).Value = Time
'Grund
Worksheets("Autorisierungs?bersicht").Range("E" & ?ber).Value = "***Bonabbruch***"
'Betrag
Worksheets("Autorisierungs?bersicht").Range("F" & ?ber).Value = Worksheets(" _
POS_Erfassung").Range("i2").Value
'Verantwortlicher
Worksheets("Autorisierungs?bersicht").Range("G" & ?ber).Value = Worksheets(" _
Mitarbeiterstamm").Range("D" & Bediener.Row).Value
'Name
Worksheets("Autorisierungs?bersicht").Range("H" & ?ber).Value = Worksheets(" _
Mitarbeiterstamm").Range("C" & Bediener.Row).Value & "," & " " & Worksheets("Mitarbeiterstamm").Range("B" & Bediener.Row).Value
Worksheets("POS_Erfassung").Range("R29").Value = ""
Dim Pos As Long
Pos = Worksheets("Bonjournal").Range("A9999").End(xlUp).Row
With Worksheets("Bonjournal")
.Range("i5").Value = Pos
'BonNr
Worksheets("Bonjournal").Range("A" & Pos + 1).Value = .Range("i5").Value + 999
Worksheets("POS_Erfassung").Range("c29").Value = .Range("i5").Value + 1000
'Umsatz
.Range("B" & Pos + 1).Value = "0"
'Bediener
.Range("C" & Pos + 1).Value = Worksheets("POS_Bezahlung").Range("D3").Value
'Name
Dim Bediener3 As Range
Set Bediener3 = Worksheets("Mitarbeiterstamm").Columns(4).Find(what:=Worksheets(" _
Bonjournal").Range("C" & Pos + 1).Value, _
lookat:=xlWhole)
If Not Bediener3 Is Nothing Then
.Range("D" & Pos + 1).Value = Worksheets("Mitarbeiterstamm").Range("C" & Bediener3.Row). _
Value & "," & " " & Worksheets("Mitarbeiterstamm").Range("B" & Bediener3.Row).Value
'Zahlungsart
.Range("E" & Pos + 1).Value = "---"
'Sonstiges
.Range("F" & Pos + 1).Value = "***Bonabbruch***"
End If
End With
MsgBox "Bon wurde erfolgreich abgebrochen", vbokayonly, "Best?tigung"
Worksheets("POS_Erfassung").Activate
Worksheets("POS_Erfassung").Range("R18").Activate
Worksheets("POS_Erfassung").Range("C8:F24").Value = ""
Worksheets("POS_Erfassung").Range("C8:F24").Font.Strikethrough = False
Worksheets("POS_Erfassung").Range("R26").Value = 0
Worksheets("POS_Erfassung").Range("R27").Value = 0
Worksheets("POS_Erfassung").Range("S26").Value = 0
Worksheets("POS_Erfassung").Range("S27").Value = 0
Worksheets("POS_Bezahlung").Range("C8:F24").Font.Strikethrough = False
Exit Sub
'Backoffice
Backoffice:
UserForm1.Label7.Caption = Worksheets("Mitarbeiterstamm").Range("D" & Bediener.Row).Value & "," _
& " " & Worksheets("Mitarbeiterstamm").Range("C" & Bediener.Row).Value & " " & Worksheets("Mitarbeiterstamm").Range("B" & Bediener.Row).Value
UserForm1.Show
Worksheets("POS_Erfassung").Activate
Dim ?ber2 As Long
?ber2 = Worksheets("Autorisierungs?bersicht").Range("A99999").End(xlUp).Row + 1
'Autorisierungs?bersicht
'Bediener
Worksheets("Autorisierungs?bersicht").Range("A" & ?ber2).Value = Worksheets(" _
POS_Erfassung").Range("D3").Value
'Name
Dim Bediener4 As Range
Set Bediener4 = Worksheets("Mitarbeiterstamm").Columns(4).Find(what:=Worksheets(" _
Autorisierungs?bersicht").Range("A" & ?ber2).Value, _
lookat:=xlWhole)
If Not Bediener4 Is Nothing Then
Worksheets("Autorisierungs?bersicht").Range("B" & ?ber2).Value = Worksheets(" _
Mitarbeiterstamm").Range("C" & Bediener4.Row).Value & "," & " " & Worksheets("Mitarbeiterstamm").Range("B" & Bediener4.Row).Value
End If
'Datum
Worksheets("Autorisierungs?bersicht").Range("C" & ?ber2).Value = Date
'Uhrzeit
Worksheets("Autorisierungs?bersicht").Range("D" & ?ber2).Value = Time
'Grund
Worksheets("Autorisierungs?bersicht").Range("E" & ?ber2).Value = "Backoffice _
gestartet"
'Betrag
Worksheets("Autorisierungs?bersicht").Range("F" & ?ber2).Value = "---"
'Verantwortlicher
Worksheets("Autorisierungs?bersicht").Range("G" & ?ber2).Value = Worksheets(" _
Mitarbeiterstamm").Range("D" & Bediener.Row).Value
'Name
Worksheets("Autorisierungs?bersicht").Range("H" & ?ber2).Value = Worksheets(" _
Mitarbeiterstamm").Range("C" & Bediener.Row).Value & "," & " " & Worksheets("Mitarbeiterstamm").Range("B" & Bediener.Row).Value
Worksheets("POS_Erfassung").Range("R29").Value = ""
Exit Sub
'Bonstorno
Bonstorno:
UserForm2.Show
Worksheets("POS_Erfassung").Activate
Exit Sub
Retoure: Exit Sub
Parken: Exit Sub
Wechselgeldzuteilung: Exit Sub
Else: MsgBox "Bediener nicht zur Autorisierung berechtigt", vbokayonly + vbExclamation, _
"Fehler!"
Worksheets("POS_A2").Range("R22").Activate
End If
Else: MsgBox "Bediener nicht gefunden", vbokayonly + vbExclamation, "Fehler!"
Worksheets("POS_A2").Range("R22").Activate
End If
End If
End With
End Sub