Rechnungsprogramm mit Kundendatenbank und Produktpalette in Excel VBA selber erstellen
Liste von Herstellungsschritten und Code
8_Rechnungsprogramm mit Kundendatenbank und Produktpalette in Excel VBA selber erstellen_Label1
9_Rechnungsprogramm mit Kundendatenbank und Produktpalette in Excel VBA selber erstellen_ComboBox1
10_Rechnungsprogramm mit Kundendatenbank und Produktpalette in Excel VBA selber erstellen_Label2
12_Rechnungsprogramm mit Kundendatenbank und Produktpalette in Excel VBA selber erstellen_Frame1
14_Rechnungsprogramm mit Kundendatenbank und Produktpalette in Excel VBA selber erstellen_ ListBox1
15_Rechnungsprogramm mit Kundendatenbank und Produktpalette in Excel VBA selber erstellen_Label12
17_Rechnungsprogramm mit Kundendatenbank und Produktpalette in Excel VBA selber erstellen_Label21
18_Rechnungsprogramm mit Kundendatenbank und Produktpalette in Excel VBA selber erstellen_ Label22
19_Rechnungsprogramm mit Kundendatenbank und Produktpalette in Excel VBA selber erstellen_ComboBox2
20_Rechnungsprogramm mit Kundendatenbank und Produktpalette in Excel VBA selber erstellen_Label23
22_Rechnungsprogramm mit Kundendatenbank und Produktpalette in Excel VBA selber erstellen_TextBox1
28_Rechnungsprogramm mit Kundendatenbank und Produktpalette in Excel VBA selber erstellen_TextBox2
'''1_1_ R##########
On Error GoTo EERR
Dim BLATBLAT As Integer
For BLATBLAT = 1 To Worksheets.Count
Worksheets(BLATBLAT).Activate
ActiveWindow.View = xlNormalView
Next BLATBLAT
Worksheets(1).Activate
UserForm1.Show
Exit Sub
EERR:
'''1_1_ R##########
'''2_1_ R##########
=D2*(E2+100)/100
'''2_1_ R##########
'''3_1_ R##########
Sub AAAUUFAF()
On Error GoTo ERR
TBB1.BackColor = &HC0FFFF
TBB2.BackColor = &HC0FFFF
KuNr.Enabled = True
KuNr.BackColor = &HC0FFFF
Dim IC As String
IC = CoB1
If CoB1 > "" Then
Sheets(IC).Activate
End If
If ActiveSheet.Name <> "Zäler" And ActiveSheet.Name <> "POMO" Then
Dim AAAZ As Variant
Dim AAAC As Variant
POMO.[a2] = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
POMO.[a3] = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Column
AAAZ = CDbl(POMO.[a2])
AAAC = CDbl(POMO.[a3])
SPALTA1 = ""
SPALTA2 = ""
SPALTA3 = ""
SPALTA4 = ""
SPALTA5 = ""
SPALTA6 = ""
SPALTA7 = ""
SPALTB1 = ""
SPALTB2 = ""
SPALTB3 = ""
SPALTB4 = ""
SPALTB5 = ""
SPALTB6 = ""
SPALTB7 = ""
SPALTC1 = ""
SPALTC2 = ""
SPALTC3 = ""
SPALTC4 = ""
SPALTC5 = ""
SPALTC6 = ""
SPALTC7 = ""
SPALTD1 = ""
SPALTD2 = ""
SPALTD3 = ""
SPALTD4 = ""
SPALTD5 = ""
SPALTD6 = ""
SPALTD7 = ""
SPALTE1 = ""
SPALTE2 = ""
SPALTE3 = ""
SPALTE4 = ""
SPALTE5 = ""
SPALTE6 = ""
SPALTE7 = ""
SPALTF1 = ""
SPALTF2 = ""
SPALTF3 = ""
SPALTF4 = ""
SPALTF5 = ""
SPALTF6 = ""
SPALTF7 = ""
SPALTG1 = ""
SPALTG2 = ""
SPALTG3 = ""
SPALTG4 = ""
SPALTG5 = ""
SPALTG6 = ""
SPALTG7 = ""
SPALTA = ""
SPALTB = ""
SPALTC = ""
SPALTD = ""
SPALTE = ""
SPALTF = ""
SPALTG = ""
KuNr = ""
TBB1.Value = ""
TBB2.Value = ""
TBB3.Value = ""
TBB4.Value = ""
TBB5.Value = ""
TBB6.Value = ""
POMO.[a1] = ""
POMO.[b1] = ""
POMO.[c1] = ""
POMO.[d1] = ""
POMO.[e1] = ""
POMO.[F1] = ""
POMO.[g1] = ""
POMO.[h1] = ""
POMO.[i1] = ""
POMO.[j1] = ""
POMO.[k1] = ""
POMO.[L1] = ""
POMO.[m1] = ""
If POMO.[a2] < 65536 Then
Dim ††† As Variant
If POMO.[a3] = 1 Then
POMO.[a4] = 0
††† = POMO.[a4]
End If
If POMO.[a3] = 7 Then
POMO.[a4] = 6
††† = POMO.[a4]
End If
SPALTA = ActiveSheet.Cells(1, AAAC - †††).Value
SPALTB = ActiveSheet.Cells(1, AAAC + 1).Value
SPALTC = ActiveSheet.Cells(1, AAAC + 2).Value
SPALTD = ActiveSheet.Cells(1, AAAC + 3).Value
SPALTE = ActiveSheet.Cells(1, AAAC + 4).Value
SPALTF = ActiveSheet.Cells(1, AAAC + 5).Value
SPALTG = ActiveSheet.Cells(1, AAAC + 6).Value
If POMO.[a2] > 8 Then
SPALTA1 = ActiveSheet.Cells(AAAZ - 6, AAAC - †††).Value
SPALTB1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 1).Value
SPALTC1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 2).Value
SPALTD1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 3).Value
SPALTE1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 4).Value
SPALTF1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 5).Value
SPALTG1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 6).Value
End If
If POMO.[a2] > 7 Then
SPALTA2 = ActiveSheet.Cells(AAAZ - 5, AAAC - †††).Value
SPALTB2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 1).Value
SPALTC2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 2).Value
SPALTD2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 3).Value
SPALTE2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 4).Value
SPALTF2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 5).Value
SPALTG2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 6).Value
End If
If POMO.[a2] > 6 Then
SPALTA3 = ActiveSheet.Cells(AAAZ - 4, AAAC - †††).Value
SPALTB3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 1).Value
SPALTC3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 2).Value
SPALTD3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 3).Value
SPALTE3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 4).Value
SPALTF3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 5).Value
SPALTG3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 6).Value
End If
If POMO.[a2] > 5 Then
SPALTA4 = ActiveSheet.Cells(AAAZ - 3, AAAC - †††).Value
SPALTB4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 1).Value
SPALTC4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 2).Value
SPALTD4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 3).Value
SPALTE4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 4).Value
SPALTF4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 5).Value
SPALTG4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 6).Value
End If
If POMO.[a2] > 4 Then
SPALTA5 = ActiveSheet.Cells(AAAZ - 2, AAAC - †††).Value
SPALTB5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 1).Value
SPALTC5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 2).Value
SPALTD5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 3).Value
SPALTE5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 4).Value
SPALTF5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 5).Value
SPALTG5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 6).Value
End If
If POMO.[a2] > 3 Then
SPALTA6 = ActiveSheet.Cells(AAAZ - 1, AAAC - †††).Value
SPALTB6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 1).Value
SPALTC6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 2).Value
SPALTD6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 3).Value
SPALTE6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 4).Value
SPALTF6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 5).Value
SPALTG6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 6).Value
End If
If POMO.[a2] > 2 Then
SPALTA7 = ActiveSheet.Cells(AAAZ, AAAC - †††).Value
SPALTB7 = ActiveSheet.Cells(AAAZ, AAAC + 1).Value
SPALTC7 = ActiveSheet.Cells(AAAZ, AAAC + 2).Value
SPALTD7 = ActiveSheet.Cells(AAAZ, AAAC + 3).Value
SPALTE7 = ActiveSheet.Cells(AAAZ, AAAC + 4).Value
SPALTF7 = ActiveSheet.Cells(AAAZ, AAAC + 5).Value
SPALTG7 = ActiveSheet.Cells(AAAZ, AAAC + 6).Value
End If
End If
End If
If ActiveSheet.Name <> "Zäler" And ActiveSheet.Name <> "POMO" Then
TANA = ActiveSheet.Name
End If
Exit Sub
ERR:
End Sub
Private Sub ComboBox1_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim AAAA As Single
Dim strSuchen As Variant
For AAAA = 1 To 10
Me.Controls("Label" & CStr(AAAA + 1)) = ""
If ComboBox1.Value <> "" Then
strSuchen = ComboBox1.Value
AAAC = CDbl(RRRRRR2.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
Me.Controls("Label" & CStr(AAAA + 1)) = RRRRRR2.Cells(1, AAAA + 1) & ": " & RRRRRR2.Cells(AAAC, AAAA + 1)
End If
Next AAAA
Exit Sub
EERR:
ComboBox1.Value = ""
End Sub
Private Sub ComboBox2_Change()
On Error GoTo EERR
Label23.Caption = ""
Label24.Caption = ""
Label26.Caption = ""
TextBox1.Value = ""
If ComboBox2.Value <> "" Then
ComboBox4.Value = ""
ComboBox6.Value = ""
Dim AAAC As Long
Dim strSuchen As Variant
strSuchen = ComboBox2.Value
AAAC = CDbl(RRRRRR3.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
Label23.Caption = RRRRRR3.Cells(AAAC, 2)
On Error Resume Next
Label24.Caption = 0
Label24.Caption = Round(RRRRRR3.Cells(AAAC, 4) * 1, 2)
Label26.Caption = 0
Label26.Caption = RRRRRR3.Cells(AAAC, 5) * 1
End If
Exit Sub
EERR:
ComboBox2.Value = ""
Label23.Caption = ""
Label24.Caption = ""
Label26.Caption = ""
TextBox1.Value = ""
End Sub
Private Sub ComboBox3_Change()
On Error GoTo EERR
Label37.Caption = ""
Label38.Caption = ""
Label40.Caption = ""
TextBox2.Value = ""
If ComboBox3.Value <> "" Then
Dim AAAC As Long
Dim strSuchen As Variant
strSuchen = ComboBox3.Value
AAAC = CDbl(RRRRRR3.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
Label37.Caption = RRRRRR3.Cells(AAAC, 2)
On Error Resume Next
Label38.Caption = 0
Label38.Caption = Round(RRRRRR3.Cells(AAAC, 4) * 1, 2)
Label40.Caption = 0
Label40.Caption = RRRRRR3.Cells(AAAC, 5) * 1
End If
Exit Sub
EERR:
ComboBox3.Value = ""
Label37.Caption = ""
Label38.Caption = ""
Label40.Caption = ""
TextBox2.Value = ""
End Sub
Private Sub ComboBox4_Change()
On Error GoTo EERR
ComboBox1.Value = ""
Label21.Caption = ""
Label22.Caption = ""
Dim AAAC As Long
Dim AAAZ As Long
ComboBox5.Value = ""
Dim SCHOT As Long
If ComboBox4.Value <> "" Then
ComboBox2.Value = ""
ComboBox6.Value = ""
ComboBox5.Clear
AAAZ = CDbl(ComboBox4.Value) + 2
If AAAZ = 2 Then
ComboBox4.Value = ""
End If
For SCHOT = 0 To 39
AAAC = 3 + SCHOT * 9
If RRRRRR6.Cells(AAAZ, AAAC).Value <> "" Then
With ComboBox5
.AddItem RRRRRR6.Cells(AAAZ, AAAC).Value
End With
End If
Next SCHOT
ComboBox1.Value = RRRRRR6.Cells(AAAZ, 2).Value
RRRRRR4.Range("a24:g90").Value = ""
Call Z5ZZZBR
Call Z1ZZZL
End If
If ComboBox4.Value = "" Then
ComboBox5.Clear
Call Z5ZZZBR
RRRRRR4.[a24] = "_"
Call Z1ZZZL
End If
Exit Sub
EERR:
MsgBox "Rechnungsnummer ist nicht vorhanden!", 48, "www.excel.npage.de "
ComboBox4.Value = ""
End Sub
Private Sub ComboBox4_DropButtonClick()
On Error GoTo EERR
With RRRRRR6
ComboBox4.RowSource = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
Exit Sub
EERR:
End Sub
Private Sub ComboBox5_Change()
On Error GoTo EERR
With RRRRRR3
ComboBox3.RowSource = .Range(.Cells(2, 100), .Cells(.Cells(Rows.Count, 100).End(xlUp).Row, 100)).Address(External:=True)
End With
ComboBox3.Value = ""
Label37.Caption = ""
Label38.Caption = ""
TextBox2.Value = ""
Label39.Caption = ""
Label40.Caption = ""
Label41.Caption = ""
If ComboBox5.Value <> "" Then
With RRRRRR3
ComboBox3.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
If CDbl(ComboBox5.Value) > 40 Then
ComboBox5.Value = ""
End If
Dim AAAC As Long
Dim AAAZ As Long
AAAZ = CDbl(ComboBox4.Value) + 2
AAAC = 3 + (CDbl(ComboBox5.Value) - 1) * 9
ComboBox3.Value = RRRRRR6.Cells(AAAZ, AAAC + 1).Value
Label37.Caption = RRRRRR6.Cells(AAAZ, AAAC + 2)).Value
Label38.Caption = RRRRRR6.Cells(AAAZ, AAAC + 3)).Value
TextBox2.Value = RRRRRR6.Cells(AAAZ, AAAC + 4)).Value
Label39.Caption = RRRRRR6.Cells(AAAZ, AAAC + 5)).Value
Label40.Caption = RRRRRR6.Cells(AAAZ, AAAC + 6)).Value
Label41.Caption = RRRRRR6.Cells(AAAZ, AAAC + 8)).Value
End If
Exit Sub
EERR:
ComboBox5.Value = ""
End Sub
Private Sub ComboBox6_Change()
On Error GoTo EERR
ComboBox1.Value = ""
Label21.Caption = ""
Label22.Caption = ""
ComboBox1.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
ComboBox7.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
Dim AAAZ As Long
If ComboBox6.Value <> "" Then
ComboBox2.Value = ""
ComboBox4.Value = ""
AAAZ = CDbl(ComboBox6.Value) + 2
If AAAZ = 2 Then
ComboBox6.Value = ""
End If
ComboBox1.Value = RRRRRR6.Cells(AAAZ, 2).Value
TextBox3.Value = RRRRRR6.Cells(AAAZ, 366).Value
TextBox4.Value = RRRRRR6.Cells(AAAZ, 367).Value
ComboBox7.Value = RRRRRR6.Cells(AAAZ, 368).Value
TextBox5.Value = RRRRRR6.Cells(AAAZ, 369).Value
TextBox6.Value = RRRRRR6.Cells(AAAZ, 370).Value
TextBox7.Value = RRRRRR6.Cells(AAAZ, 371).Value
RRRRRR4.Range("a24:g90").Value = ""
Call Z6ZZZMR
Call Z1ZZZL
End If
If ComboBox6.Value = "" Then
Call Z6ZZZMR
RRRRRR4.[a24] = "_"
Call Z1ZZZL
End If
Exit Sub
EERR:
MsgBox "Rechnungsnummer ist nicht vorhanden!", 48, "www.excel.npage.de "
ComboBox6.Value = ""
End Sub
Private Sub ComboBox6_DropButtonClick()
On Error GoTo EERR
With RRRRRR6
ComboBox6.RowSource = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
Exit Sub
EERR:
End Sub
Private Sub ComboBox7_Change()
On Error GoTo EERR
If ComboBox7.Value <> "" Then
If ComboBox7.Value = "Offen" Or ComboBox7.Value = "Bezahlt" Or ComboBox7.Value = "Storniert" Then
Exit Sub
Else:
ComboBox7.Value = ""
End If
End If
Exit Sub
EERR:
End Sub
Private Sub CommandButton1_Click()
On Error GoTo EERR
If RRRRRR6.[a10001] <> "" Then
MsgBox "Kein Platz für neue Rechnungen!", 48, "www.excel.npage.de "
ComboBox2.SetFocus
Exit Sub
End If
If ComboBox2.Value = "" Then
MsgBox "Artikel ist nicht ausgewählt!", 48, "www.excel.npage.de "
ComboBox2.SetFocus
Exit Sub
End If
If TextBox1.Value = "" Then
MsgBox "Anzahl des Artikels nicht ausgewählt!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
Dim AAAZ As Long
Dim AAAC As Long
Dim SCHOT As Long
Dim AAAC2 As Long
AAAZ = CDbl(Label21.Caption) + 2
AAAC = 3 + (CDbl(Label22.Caption) - 1) * 9
If RRRRRR6.Cells(AAAZ, AAAC) <> "" Then
MsgBox "Es sind schon 40 Positionen erstellt worden", 48, "www.excel.npage.de "
ComboBox2.SetFocus
Exit Sub
End If
RRRRRR6.Cells(AAAZ, 1).Value = AAAZ - 2
RRRRRR6.Cells(AAAZ, 2) = ComboBox1.Value
RRRRRR6.Cells(AAAZ, AAAC) = CDbl(Label22.Caption)
RRRRRR6.Cells(AAAZ, AAAC + 1) = ComboBox2.Value
RRRRRR6.Cells(AAAZ, AAAC + 2) = Label23.Caption
RRRRRR6.Cells(AAAZ, AAAC + 3) = CDbl(Label24.Caption)
RRRRRR6.Cells(AAAZ, AAAC + 4) = CDbl(TextBox1.Value)
RRRRRR6.Cells(AAAZ, AAAC + 5) = CDbl(Label25.Caption)
RRRRRR6.Cells(AAAZ, AAAC + 6) = CDbl(Label26.Caption)
RRRRRR6.Cells(AAAZ, AAAC + 7) = Round(CDbl(Label25.Caption) * CDbl(Label26.Caption) / 100, 2)
RRRRRR6.Cells(AAAZ, AAAC + 8) = CDbl(Label27.Caption)
RRRRRR6.Cells(AAAZ, 363) = ""
RRRRRR6.Cells(AAAZ, 364) = ""
RRRRRR6.Cells(AAAZ, 365) = ""
For SCHOT = 0 To 39
AAAC2 = 3 + SCHOT * 9
RRRRRR6.Cells(AAAZ, 363) = RRRRRR6.Cells(AAAZ, 363) + RRRRRR6.Cells(AAAZ, AAAC2 + 5)
RRRRRR6.Cells(AAAZ, 364) = RRRRRR6.Cells(AAAZ, 364) + RRRRRR6.Cells(AAAZ, AAAC2 + 7)
RRRRRR6.Cells(AAAZ, 365) = RRRRRR6.Cells(AAAZ, 365) + RRRRRR6.Cells(AAAZ, AAAC2 + 8)
RRRRRR6.Cells(AAAZ, 368) = "Offen"
Next SCHOT
RRRRRR6.Cells(AAAZ, 366) = Date
Call Z3ZZZPR
ComboBox2.Value = ""
TextBox1.Value = ""
ComboBox2.SetFocus
RRRRRR4.Range("a24:g90").Value = ""
Call Z4ZZZNR
Call Z1ZZZL
Exit Sub
EERR:
End Sub
Private Sub CommandButton2_Click()
On Error GoTo EERR
Call Z4ZZZNR
Dim ††† As Long
RRRRRR6.Activate
RRRRRR6.[nh2].Select
Selection.Copy
RRRRRR4.Activate
††† = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row)
RRRRRR4.Cells(††† + 2, 1).Select
ActiveSheet.Paste
RRRRRR4.Cells(††† + 2, 1).RowHeight = RRRRRR6.[nh2].RowHeight
Application.CutCopyMode = False
RRRRRR4.Activate
ActiveSheet.Cells(Rows.Count, 1).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 2).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 3).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 4).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 5).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 6).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 7).EntireColumn.AutoFit
With ActiveSheet.PageSetup
.RightHeader = "Rechnung-Nr.: " & RRRRRR4.[g7] & " &P/&N"
End With
UserForm1.Hide
Exit Sub
EERR:
End Sub
Private Sub CommandButton3_Click()
On Error GoTo EERR
If ComboBox5.Value = "" Then
MsgBox "Positionsnummer ist nicht ausgewählt!", 48, "www.excel.npage.de "
ComboBox5.SetFocus
Exit Sub
End If
TextBox2.SetFocus
ComboBox5.SetFocus
Dim AAAZ As Long
Dim AAAC As Long
Dim SCHOT As Long
Dim AAAC2 As Long
AAAZ = CDbl(ComboBox4.Value) + 2
If RRRRRR6.Cells(AAAZ, 368) <> "" Then
If RRRRRR6.Cells(AAAZ, 368) = "Bezahlt" Or RRRRRR6.Cells(AAAZ, 368) = "Storniert" Then
MsgBox "Die Rechnung ist schon als " & RRRRRR6.Cells(AAAZ, 368) & " markiert!", 48, "www.excel.npage.de "
ComboBox5.SetFocus
Exit Sub
End If
End If
AAAC = 3 + (CDbl(ComboBox5.Value) - 1) * 9
RRRRRR6.Cells(AAAZ, 2) = ComboBox1.Value
RRRRRR6.Cells(AAAZ, AAAC) = CDbl(ComboBox5.Value)
RRRRRR6.Cells(AAAZ, AAAC + 1) = ComboBox3.Value
RRRRRR6.Cells(AAAZ, AAAC + 2) = Label37.Caption
If Label38.Caption <> "" Then
RRRRRR6.Cells(AAAZ, AAAC + 3) = CDbl(Label38.Caption)
Else:
RRRRRR6.Cells(AAAZ, AAAC + 3) = ""
End If
If TextBox2.Value <> "" Then
RRRRRR6.Cells(AAAZ, AAAC + 4) = CDbl(TextBox2.Value)
Else:
RRRRRR6.Cells(AAAZ, AAAC + 4) = ""
End If
If Label39.Caption <> "" Then
RRRRRR6.Cells(AAAZ, AAAC + 5) = CDbl(Label39.Caption)
Else:
RRRRRR6.Cells(AAAZ, AAAC + 5) = ""
End If
If Label40.Caption <> "" Then
RRRRRR6.Cells(AAAZ, AAAC + 6) = CDbl(Label40.Caption)
Else:
RRRRRR6.Cells(AAAZ, AAAC + 6) = ""
End If
If Label39.Caption <> "" And Label40.Caption <> "" Then
RRRRRR6.Cells(AAAZ, AAAC + 7) = Round(CDbl(Label39.Caption) * CDbl(Label40.Caption) / 100, 2)
Else:
RRRRRR6.Cells(AAAZ, AAAC + 7) = ""
End If
If Label41.Caption <> "" Then
RRRRRR6.Cells(AAAZ, AAAC + 8) = CDbl(Label41.Caption)
Else:
RRRRRR6.Cells(AAAZ, AAAC + 8) = ""
End If
RRRRRR6.Cells(AAAZ, 363) = ""
RRRRRR6.Cells(AAAZ, 364) = ""
RRRRRR6.Cells(AAAZ, 365) = ""
For SCHOT = 0 To 39
AAAC2 = 3 + SCHOT * 9
RRRRRR6.Cells(AAAZ, 363) = RRRRRR6.Cells(AAAZ, 363) + RRRRRR6.Cells(AAAZ, AAAC2 + 5)
RRRRRR6.Cells(AAAZ, 364) = RRRRRR6.Cells(AAAZ, 364) + RRRRRR6.Cells(AAAZ, AAAC2 + 7)
RRRRRR6.Cells(AAAZ, 365) = RRRRRR6.Cells(AAAZ, 365) + RRRRRR6.Cells(AAAZ, AAAC2 + 8)
Next SCHOT
RRRRRR6.Cells(AAAZ, 367) = Date
ComboBox5.Clear
For SCHOT = 0 To 39
AAAC = 3 + SCHOT * 9
If RRRRRR6.Cells(AAAZ, AAAC).Value <> "" Then
With ComboBox5
.AddItem RRRRRR6.Cells(AAAZ, AAAC).Value
End With
End If
Next SCHOT
ComboBox3.Value = ""
TextBox2.Value = ""
ComboBox5.SetFocus
RRRRRR4.Range("a24:g90").Value = ""
Call Z5ZZZBR
Call Z1ZZZL
Exit Sub
EERR:
End Sub
Private Sub CommandButton4_Click()
On Error GoTo EERR
Call Z5ZZZBR
Dim ††† As Long
RRRRRR6.Activate
RRRRRR6.[nh2].Select
Selection.Copy
RRRRRR4.Activate
††† = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row)
RRRRRR4.Cells(††† + 2, 1).Select
ActiveSheet.Paste
RRRRRR4.Cells(††† + 2, 1).RowHeight = RRRRRR6.[nh2].RowHeight
Application.CutCopyMode = False
RRRRRR4.Activate
ActiveSheet.Cells(Rows.Count, 1).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 2).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 3).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 4).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 5).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 6).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 7).EntireColumn.AutoFit
With ActiveSheet.PageSetup
.RightHeader = "Rechnung-Nr.: " & RRRRRR4.[g7] & " &P/&N"
End With
UserForm1.Hide
Exit Sub
EERR:
End Sub
Private Sub CommandButton5_Click()
On Error GoTo EERR
TextBox3.SetFocus
TextBox4.SetFocus
TextBox6.SetFocus
ComboBox6.SetFocus
Dim AAAZ As Long
If ComboBox6.Value <> "" Then
AAAZ = CDbl(ComboBox6.Value) + 2
RRRRRR6.Cells(AAAZ, 2) = ComboBox1.Value
If TextBox3.Value <> "" Then
RRRRRR6.Cells(AAAZ, 366) = CDate(TextBox3.Value)
Else:
RRRRRR6.Cells(AAAZ, 366) = ""
End If
If TextBox4.Value <> "" Then
RRRRRR6.Cells(AAAZ, 367) = CDate(TextBox4.Value)
Else:
RRRRRR6.Cells(AAAZ, 367) = ""
End If
RRRRRR6.Cells(AAAZ, 368) = ComboBox7.Value
RRRRRR6.Cells(AAAZ, 369) = TextBox5.Value
If TextBox6.Value <> "" Then
RRRRRR6.Cells(AAAZ, 370) = CDate(TextBox6.Value)
Else:
RRRRRR6.Cells(AAAZ, 370) = ""
End If
RRRRRR6.Cells(AAAZ, 371) = TextBox7.Value
RRRRRR4.Range("a24:g90").Value = ""
Call Z6ZZZMR
Call Z1ZZZL
End If
If ComboBox6.Value = "" Then
Call Z6ZZZMR
RRRRRR4.[a24] = "_"
Call Z1ZZZL
End If
Exit Sub
EERR:
End Sub
Private Sub CommandButton6_Click()
On Error GoTo EERR
Call Z6ZZZMR
Dim ††† As Long
RRRRRR6.Activate
RRRRRR6.[nh2].Select
Selection.Copy
RRRRRR4.Activate
††† = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row)
RRRRRR4.Cells(††† + 2, 1).Select
ActiveSheet.Paste
RRRRRR4.Cells(††† + 2, 1).RowHeight = RRRRRR6.[nh2].RowHeight
Application.CutCopyMode = False
RRRRRR4.Activate
ActiveSheet.Cells(Rows.Count, 1).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 2).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 3).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 4).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 5).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 6).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 7).EntireColumn.AutoFit
With ActiveSheet.PageSetup
.RightHeader = "Rechnung-Nr.: " & RRRRRR4.[g7] & " &P/&N"
End With
UserForm1.Hide
Exit Sub
EERR:
End Sub
Private Sub CommandButton7_Click()
On Error GoTo EERR
Label21.Caption = ""
ComboBox2.Value = ""
ComboBox4.Value = ""
ComboBox6.Value = ""
ComboBox1.Value = ""
Call Z2ZZZNR
Call Z3ZZZPR
Exit Sub
EERR:
End Sub
Private Sub CommandButton9_Click()
On Error GoTo EERR
Unload Me
Dim AAAA As Variant
AAAA = MsgBox("" & "Moechten Sie wirklich alle Rechnungen loeschen?" & " " & "", vbYesNo, "www.excel.npage.de Alles loeschen")
If AAAA = vbNo Then
Exit Sub
Else
End If
strSuchen = Application.InputBox("Kennwort:", "www.excel.npage.de Alles loeschen ")
If strSuchen <> 3 Then
AAAA = MsgBox("Das Kennwort ist falsch!", , "www.excel.npage.de Alles loeschen")
Exit Sub
Else
End If
RRRRRR6.Range("a2:ng65530").Value = ""
MsgBox "Alles ist geloescht!", 48, "www.excel.npage.de "
Exit Sub
EERR:
End Sub
Private Sub CommandButton8_Click()
On Error GoTo EERR
RRRRRR6.Activate
Cells.Select
Selection.Copy
RRRRRR5.Activate
RRRRRR5.[a1].Select
ActiveSheet.Paste
Dim SCHOT As Long
For SCHOT = 1 To 374
ActiveSheet.Cells(Rows.Count, SCHOT).EntireColumn.AutoFit
Next SCHOT
RRRRRR5.[a1].Select
Application.CutCopyMode = False
ActiveSheet.AutoFilterMode = False
UserForm1.Hide
Exit Sub
EERR:
UserForm1.Hide
End Sub
Sub DDDUUFAF()
On Error GoTo ERR
TBB1.BackColor = &HC0FFFF
TBB2.BackColor = &HC0FFFF
KuNr.Enabled = True
KuNr.BackColor = &HC0FFFF
Dim IC As String
IC = CoB1
If CoB1 > "" Then
Sheets(IC).Activate
End If
If ActiveSheet.Name <> "Zäler" And ActiveSheet.Name <> "POMO" Then
Dim AAAZ As Variant
Dim AAAC As Variant
POMO.[a2] = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
POMO.[a3] = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Column
AAAZ = CDbl(POMO.[a2])
AAAC = CDbl(POMO.[a3])
SPALTA1 = ""
SPALTA2 = ""
SPALTA3 = ""
SPALTA4 = ""
SPALTA5 = ""
SPALTA6 = ""
SPALTA7 = ""
SPALTB1 = ""
SPALTB2 = ""
SPALTB3 = ""
SPALTB4 = ""
SPALTB5 = ""
SPALTB6 = ""
SPALTB7 = ""
SPALTC1 = ""
SPALTC2 = ""
SPALTC3 = ""
SPALTC4 = ""
SPALTC5 = ""
SPALTC6 = ""
SPALTC7 = ""
SPALTD1 = ""
SPALTD2 = ""
SPALTD3 = ""
SPALTD4 = ""
SPALTD5 = ""
SPALTD6 = ""
SPALTD7 = ""
SPALTE1 = ""
SPALTE2 = ""
SPALTE3 = ""
SPALTE4 = ""
SPALTE5 = ""
SPALTE6 = ""
SPALTE7 = ""
SPALTF1 = ""
SPALTF2 = ""
SPALTF3 = ""
SPALTF4 = ""
SPALTF5 = ""
SPALTF6 = ""
SPALTF7 = ""
SPALTG1 = ""
SPALTG2 = ""
SPALTG3 = ""
SPALTG4 = ""
SPALTG5 = ""
SPALTG6 = ""
SPALTG7 = ""
SPALTA = ""
SPALTB = ""
SPALTC = ""
SPALTD = ""
SPALTE = ""
SPALTF = ""
SPALTG = ""
KuNr = ""
TBB1.Value = ""
TBB2.Value = ""
TBB3.Value = ""
TBB4.Value = ""
TBB5.Value = ""
TBB6.Value = ""
POMO.[a1] = ""
POMO.[b1] = ""
POMO.[c1] = ""
POMO.[d1] = ""
POMO.[e1] = ""
POMO.[F1] = ""
POMO.[g1] = ""
POMO.[h1] = ""
POMO.[i1] = ""
POMO.[j1] = ""
POMO.[k1] = ""
POMO.[L1] = ""
POMO.[m1] = ""
If POMO.[a2] < 65536 Then
Dim ††† As Variant
If POMO.[a3] = 1 Then
POMO.[a4] = 0
††† = POMO.[a4]
End If
If POMO.[a3] = 7 Then
POMO.[a4] = 6
††† = POMO.[a4]
End If
SPALTA = ActiveSheet.Cells(1, AAAC - †††).Value
SPALTB = ActiveSheet.Cells(1, AAAC + 1).Value
SPALTC = ActiveSheet.Cells(1, AAAC + 2).Value
SPALTD = ActiveSheet.Cells(1, AAAC + 3).Value
SPALTE = ActiveSheet.Cells(1, AAAC + 4).Value
SPALTF = ActiveSheet.Cells(1, AAAC + 5).Value
SPALTG = ActiveSheet.Cells(1, AAAC + 6).Value
If POMO.[a2] > 8 Then
SPALTA1 = ActiveSheet.Cells(AAAZ - 6, AAAC - †††).Value
SPALTB1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 1).Value
SPALTC1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 2).Value
SPALTD1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 3).Value
SPALTE1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 4).Value
SPALTF1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 5).Value
SPALTG1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 6).Value
End If
If POMO.[a2] > 7 Then
SPALTA2 = ActiveSheet.Cells(AAAZ - 5, AAAC - †††).Value
SPALTB2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 1).Value
SPALTC2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 2).Value
SPALTD2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 3).Value
SPALTE2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 4).Value
SPALTF2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 5).Value
SPALTG2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 6).Value
End If
If POMO.[a2] > 6 Then
SPALTA3 = ActiveSheet.Cells(AAAZ - 4, AAAC - †††).Value
SPALTB3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 1).Value
SPALTC3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 2).Value
SPALTD3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 3).Value
SPALTE3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 4).Value
SPALTF3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 5).Value
SPALTG3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 6).Value
End If
If POMO.[a2] > 5 Then
SPALTA4 = ActiveSheet.Cells(AAAZ - 3, AAAC - †††).Value
SPALTB4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 1).Value
SPALTC4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 2).Value
SPALTD4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 3).Value
SPALTE4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 4).Value
SPALTF4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 5).Value
SPALTG4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 6).Value
End If
If POMO.[a2] > 4 Then
SPALTA5 = ActiveSheet.Cells(AAAZ - 2, AAAC - †††).Value
SPALTB5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 1).Value
SPALTC5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 2).Value
SPALTD5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 3).Value
SPALTE5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 4).Value
SPALTF5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 5).Value
SPALTG5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 6).Value
End If
If POMO.[a2] > 3 Then
SPALTA6 = ActiveSheet.Cells(AAAZ - 1, AAAC - †††).Value
SPALTB6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 1).Value
SPALTC6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 2).Value
SPALTD6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 3).Value
SPALTE6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 4).Value
SPALTF6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 5).Value
SPALTG6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 6).Value
End If
If POMO.[a2] > 2 Then
SPALTA7 = ActiveSheet.Cells(AAAZ, AAAC - †††).Value
SPALTB7 = ActiveSheet.Cells(AAAZ, AAAC + 1).Value
SPALTC7 = ActiveSheet.Cells(AAAZ, AAAC + 2).Value
SPALTD7 = ActiveSheet.Cells(AAAZ, AAAC + 3).Value
SPALTE7 = ActiveSheet.Cells(AAAZ, AAAC + 4).Value
SPALTF7 = ActiveSheet.Cells(AAAZ, AAAC + 5).Value
SPALTG7 = ActiveSheet.Cells(AAAZ, AAAC + 6).Value
End If
End If
End If
If ActiveSheet.Name <> "Zäler" And ActiveSheet.Name <> "POMO" Then
TANA = ActiveSheet.Name
End If
Exit Sub
ERR:
End Sub
Private Sub TextBox1_Change()
On Error GoTo EERR
Label25.Caption = ""
Label27.Caption = ""
If TextBox1.Value <> "" Then
Label25.Caption = Round(CDbl(TextBox1.Value) * CDbl(Label24.Caption), 2)
Label27.Caption = Round(CDbl(Label25.Caption) * (CDbl(Label26.Caption) + 100) / 100, 2)
End If
Exit Sub
EERR:
TextBox1.Value = ""
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
Label39.Caption = ""
Label41.Caption = ""
TextBox2.Value = CDbl(TextBox2.Value) * 1
If ComboBox3.Value <> "" Then
Dim AAAC As Long
Dim strSuchen As Variant
strSuchen = ComboBox3.Value
AAAC = CDbl(RRRRRR3.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
Label37.Caption = RRRRRR3.Cells(AAAC, 2)
On Error Resume Next
Label38.Caption = 0
Label38.Caption = Round(RRRRRR3.Cells(AAAC, 4) * 1, 2)
Label40.Caption = 0
Label40.Caption = RRRRRR3.Cells(AAAC, 5) * 1
End If
If TextBox2.Value <> "" Then
Label39.Caption = Round(CDbl(TextBox2.Value) * CDbl(Label38.Caption), 2)
Label41.Caption = Round(CDbl(Label39.Caption) * (CDbl(Label40.Caption) + 100) / 100, 2)
End If
Exit Sub
EERR:
TextBox2.Value = ""
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
If TextBox3.Value <> "" Then
TextBox3.Value = CDate(TextBox3)
End If
Exit Sub
EERR:
TextBox3.Value = Date
End Sub
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
If TextBox4.Value <> "" Then
TextBox4.Value = CDate(TextBox4)
End If
Exit Sub
EERR:
TextBox4.Value = Date
End Sub
Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
If TextBox6.Value <> "" Then
TextBox6.Value = CDate(TextBox6)
End If
Exit Sub
EERR:
TextBox6.Value = Date
End Sub
Private Sub UserForm_Activate()
On Error GoTo EERR
RRRRRR4.Activate
ActiveWindow.View = xlNormalView
RRRRRR1.Activate
Exit Sub
EERR:
End Sub
Private Sub UserForm_Initialize()
On Error GoTo EERR
Call ZZUUFF
With UserForm1
.Height = 431
.Width = 600
End With
With Me
End With
With RRRRRR2
ComboBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
Call rrrrch
Call Z1ZZZL
Call Z2ZZZNR
Call Z3ZZZPR
With RRRRRR3
ComboBox2.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
ComboBox7.Clear
With ComboBox7
.AddItem "Offen"
.AddItem "Bezahlt"
.AddItem "Storniert"
End With
Exit Sub
EERR:
End Sub
Sub rrrrch()
On Error GoTo EERR
If RRRRRR1.Cells(1961, 1962) <> Date Then
RRRRRR1.Cells(1961, 1962) = Date
ActiveWorkbook.FollowHyperlink Address:="https://youtu.be/tO4beEUwcWo", NewWindow:=True
End If
Exit Sub
EERR:
End Sub
Sub Z1ZZZL()
On Error GoTo EERR
With RRRRRR4
ListBox1.RowSource = .Range(.Cells(24, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 7)).Address(External:=True)
ListBox1.ListIndex = ListBox1.ListCount - 1
End With
Exit Sub
EERR:
End Sub
Sub Z2ZZZNR()
On Error GoTo EERR
RRRRRR6.[a2] = 0
RRRRRR6.[c2] = 0
Dim AAAZ As Long
AAAZ = CDbl(RRRRRR6.Cells(Rows.Count, 1).End(xlUp).Row)
Label21.Caption = AAAZ - 1
RRRRRR4.Range("a24:g90").Value = ""
RRRRRR4.[a24] = "_"
Exit Sub
EERR:
End Sub
Sub Z3ZZZPR()
On Error GoTo EERR
Dim SCHOT As Long
Dim AAAC As Long
Dim AAAZ As Long
AAAZ = CDbl(Label21.Caption) + 2
For SCHOT = 0 To 39
AAAC = 3 + SCHOT * 9
If RRRRRR6.Cells(AAAZ, AAAC).Value = "" Then
Label22.Caption = SCHOT + 1
Exit Sub
End If
Next SCHOT
Exit Sub
EERR:
End Sub
Sub Z4ZZZNR()
On Error GoTo EERR
Dim AAAZ As Long
Dim AAAZ2 As Long
Dim AAAC As Long
Dim AAAZ3 As Long
Dim SCHOT As Long
Dim strSuchen As Variant
RRRRRR4.[g6] = ""
RRRRRR4.[g7] = ""
RRRRRR4.[g8] = ""
RRRRRR4.[g9] = ""
RRRRRR4.[a6] = ""
RRRRRR4.[a7] = ""
RRRRRR4.[a8] = ""
RRRRRR4.[a9] = ""
RRRRRR4.[a10] = ""
RRRRRR4.[a11] = ""
RRRRRR4.[a12] = ""
RRRRRR4.Range("a24:g90").Value = ""
RRRRRR4.Range("a24:g90").Font.Size = 11
RRRRRR4.Activate
RRRRRR4.Range("a24:g90").UnMerge
RRRRRR4.Range("a24:g90").RowHeight = 15
RRRRRR4.Range("a24:g90").HorizontalAlignment = xlCenter
AAAZ = CDbl(Label21.Caption) + 2
RRRRRR4.[g6] = RRRRRR6.Cells(AAAZ, 2)
RRRRRR4.[g7] = CDbl(Label21.Caption)
RRRRRR4.[g8] = RRRRRR6.Cells(AAAZ, 366)
If RRRRRR4.[g8] <> "" Then
RRRRRR4.[g8] = CDate(RRRRRR6.Cells(AAAZ, 366))
Else:
RRRRRR4.[g8] = ""
End If
RRRRRR4.[e9] = ""
RRRRRR4.[g9] = ""
strSuchen = RRRRRR6.Cells(AAAZ, 2)
AAAZ3 = CDbl(RRRRRR2.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
RRRRRR4.[a6] = RRRRRR2.Cells(AAAZ3, 2)
RRRRRR4.[a7] = RRRRRR2.Cells(AAAZ3, 3)
RRRRRR4.[a8] = RRRRRR2.Cells(AAAZ3, 4)
RRRRRR4.[a9] = RRRRRR2.Cells(AAAZ3, 5)
RRRRRR4.[a10] = RRRRRR2.Cells(AAAZ3, 6)
RRRRRR4.[a11] = RRRRRR2.Cells(AAAZ3, 7)
RRRRRR4.[a12] = RRRRRR2.Cells(AAAZ3, 8)
For SCHOT = 0 To 39
AAAZ2 = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row) + 1
AAAC = 3 + SCHOT * 9
If RRRRRR6.Cells(AAAZ, AAAC) <> "" Then
RRRRRR4.Cells(AAAZ2, 1) = RRRRRR6.Cells(AAAZ, AAAC)
RRRRRR4.Cells(AAAZ2, 2) = RRRRRR6.Cells(AAAZ, AAAC + 1)
RRRRRR4.Cells(AAAZ2, 3) = RRRRRR6.Cells(AAAZ, AAAC + 2)
RRRRRR4.Cells(AAAZ2, 4) = RRRRRR6.Cells(AAAZ, AAAC + 3) & "_x_" & RRRRRR6.Cells(AAAZ, AAAC + 4)
RRRRRR4.Cells(AAAZ2, 5) = RRRRRR6.Cells(AAAZ, AAAC + 5)
RRRRRR4.Cells(AAAZ2, 6) = RRRRRR6.Cells(AAAZ, AAAC + 6)
RRRRRR4.Cells(AAAZ2, 7) = RRRRRR6.Cells(AAAZ, AAAC + 8)
End If
Next SCHOT
AAAZ2 = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row) + 1
RRRRRR4.Cells(AAAZ2, 3) = "Netto:"
RRRRRR4.Cells(AAAZ2 + 1, 3) = "MwSt.:"
RRRRRR4.Cells(AAAZ2 + 2, 3) = "Brutto:"
RRRRRR4.Cells(AAAZ2 + 2, 1) = "_"
RRRRRR4.Cells(AAAZ2, 4) = RRRRRR6.Cells(AAAZ, 363)
RRRRRR4.Cells(AAAZ2 + 1, 4) = RRRRRR6.Cells(AAAZ, 364)
RRRRRR4.Cells(AAAZ2 + 2, 4) = RRRRRR6.Cells(AAAZ, 365)
Exit Sub
EERR:
End Sub
Sub Z5ZZZBR()
On Error GoTo EERR
Dim AAAZ As Long
Dim AAAZ2 As Long
Dim AAAC As Long
Dim AAAZ3 As Long
Dim SCHOT As Long
Dim strSuchen As Variant
RRRRRR4.Activate
RRRRRR4.Range("a24:g90").UnMerge
RRRRRR4.Range("a24:g90").RowHeight = 15
RRRRRR4.Range("a24:g90").Value = ""
RRRRRR4.Range("a24:g90").HorizontalAlignment = xlCenter
RRRRRR4.[g6] = ""
RRRRRR4.[g7] = ""
RRRRRR4.[g8] = ""
RRRRRR4.[g9] = ""
RRRRRR4.[a6] = ""
RRRRRR4.[a7] = ""
RRRRRR4.[a8] = ""
RRRRRR4.[a9] = ""
RRRRRR4.[a10] = ""
RRRRRR4.[a11] = ""
RRRRRR4.[a12] = ""
RRRRRR4.Range("a24:g90").Value = ""
RRRRRR4.Range("a24:g90").Font.Size = 11
AAAZ = CDbl(ComboBox4.Value) + 2
RRRRRR4.[g6] = RRRRRR6.Cells(AAAZ, 2)
RRRRRR4.[g7] = CDbl(ComboBox4.Value)
RRRRRR4.[g8] = RRRRRR6.Cells(AAAZ, 366)
If RRRRRR4.[g8] <> "" Then
RRRRRR4.[g8] = CDate(RRRRRR6.Cells(AAAZ, 366))
Else:
RRRRRR4.[g8] = ""
End If
If RRRRRR6.Cells(AAAZ, 367) <> "" Then
RRRRRR4.[e9] = "Geändert am:"
RRRRRR4.[g9] = CDate(RRRRRR6.Cells(AAAZ, 367))
Else:
RRRRRR4.[e9] = ""
RRRRRR4.[g9] = ""
End If
strSuchen = RRRRRR6.Cells(AAAZ, 2)
AAAZ3 = CDbl(RRRRRR2.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
RRRRRR4.[a6] = RRRRRR2.Cells(AAAZ3, 2)
RRRRRR4.[a7] = RRRRRR2.Cells(AAAZ3, 3)
RRRRRR4.[a8] = RRRRRR2.Cells(AAAZ3, 4)
RRRRRR4.[a9] = RRRRRR2.Cells(AAAZ3, 5)
RRRRRR4.[a10] = RRRRRR2.Cells(AAAZ3, 6)
RRRRRR4.[a11] = RRRRRR2.Cells(AAAZ3, 7)
RRRRRR4.[a12] = RRRRRR2.Cells(AAAZ3, 8)
For SCHOT = 0 To 39
AAAZ2 = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row) + 1
AAAC = 3 + SCHOT * 9
If RRRRRR6.Cells(AAAZ, AAAC) <> "" Then
RRRRRR4.Cells(AAAZ2, 1) = RRRRRR6.Cells(AAAZ, AAAC)
RRRRRR4.Cells(AAAZ2, 2) = RRRRRR6.Cells(AAAZ, AAAC + 1)
RRRRRR4.Cells(AAAZ2, 3) = RRRRRR6.Cells(AAAZ, AAAC + 2)
RRRRRR4.Cells(AAAZ2, 4) = RRRRRR6.Cells(AAAZ, AAAC + 3) & "_x_" & RRRRRR6.Cells(AAAZ, AAAC + 4)
RRRRRR4.Cells(AAAZ2, 5) = RRRRRR6.Cells(AAAZ, AAAC + 5)
RRRRRR4.Cells(AAAZ2, 6) = RRRRRR6.Cells(AAAZ, AAAC + 6)
RRRRRR4.Cells(AAAZ2, 7) = RRRRRR6.Cells(AAAZ, AAAC + 8)
End If
Next SCHOT
AAAZ2 = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row) + 1
RRRRRR4.Cells(AAAZ2, 3) = "Netto:"
RRRRRR4.Cells(AAAZ2 + 1, 3) = "MwSt.:"
RRRRRR4.Cells(AAAZ2 + 2, 3) = "Brutto:"
RRRRRR4.Cells(AAAZ2 + 2, 1) = "_"
RRRRRR4.Cells(AAAZ2, 4) = RRRRRR6.Cells(AAAZ, 363)
RRRRRR4.Cells(AAAZ2 + 1, 4) = RRRRRR6.Cells(AAAZ, 364)
RRRRRR4.Cells(AAAZ2 + 2, 4) = RRRRRR6.Cells(AAAZ, 365)
Exit Sub
EERR:
End Sub
Sub Z6ZZZMR()
On Error GoTo EERR
Dim AAAZ As Long
Dim AAAZ2 As Long
Dim AAAC As Long
Dim AAAZ3 As Long
Dim SCHOT As Long
Dim strSuchen As Variant
RRRRRR4.Range("a24:g90").Value = ""
RRRRRR4.Activate
RRRRRR4.Range("a24:g90").UnMerge
RRRRRR4.Range("a24:g90").RowHeight = 15
RRRRRR4.Range("a24:g90").HorizontalAlignment = xlCenter
RRRRRR4.[g6] = ""
RRRRRR4.[g7] = ""
RRRRRR4.[g8] = ""
RRRRRR4.[g9] = ""
RRRRRR4.[a6] = ""
RRRRRR4.[a7] = ""
RRRRRR4.[a8] = ""
RRRRRR4.[a9] = ""
RRRRRR4.[a10] = ""
RRRRRR4.[a11] = ""
RRRRRR4.[a12] = ""
RRRRRR4.Range("a24:g90").Value = ""
RRRRRR4.Range("a24:g90").Font.Size = 11
AAAZ = CDbl(ComboBox6.Value) + 2
RRRRRR4.[g6] = RRRRRR6.Cells(AAAZ, 2)
RRRRRR4.[g7] = CDbl(ComboBox6.Value)
RRRRRR4.[g8] = RRRRRR6.Cells(AAAZ, 366)
If RRRRRR4.[g8] <> "" Then
RRRRRR4.[g8] = CDate(RRRRRR6.Cells(AAAZ, 366))
Else:
RRRRRR4.[g8] = ""
End If
If RRRRRR6.Cells(AAAZ, 367) <> "" Then
RRRRRR4.[e9] = "Geändert am:"
RRRRRR4.[g9] = CDate(RRRRRR6.Cells(AAAZ, 367))
Else:
RRRRRR4.[e9] = ""
RRRRRR4.[g9] = ""
End If
strSuchen = RRRRRR6.Cells(AAAZ, 2)
AAAZ3 = CDbl(RRRRRR2.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
RRRRRR4.[a6] = RRRRRR2.Cells(AAAZ3, 2)
RRRRRR4.[a7] = RRRRRR2.Cells(AAAZ3, 3)
RRRRRR4.[a8] = RRRRRR2.Cells(AAAZ3, 4)
RRRRRR4.[a9] = RRRRRR2.Cells(AAAZ3, 5)
RRRRRR4.[a10] = RRRRRR2.Cells(AAAZ3, 6)
RRRRRR4.[a11] = RRRRRR2.Cells(AAAZ3, 7)
RRRRRR4.[a12] = RRRRRR2.Cells(AAAZ3, 8)
For SCHOT = 0 To 39
AAAZ2 = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row) + 1
AAAC = 3 + SCHOT * 9
If RRRRRR6.Cells(AAAZ, AAAC) <> "" Then
RRRRRR4.Cells(AAAZ2, 1) = RRRRRR6.Cells(AAAZ, AAAC)
RRRRRR4.Cells(AAAZ2, 2) = RRRRRR6.Cells(AAAZ, AAAC + 1)
RRRRRR4.Cells(AAAZ2, 3) = RRRRRR6.Cells(AAAZ, AAAC + 2)
RRRRRR4.Cells(AAAZ2, 4) = RRRRRR6.Cells(AAAZ, AAAC + 3) & "_x_" & RRRRRR6.Cells(AAAZ, AAAC + 4)
RRRRRR4.Cells(AAAZ2, 5) = RRRRRR6.Cells(AAAZ, AAAC + 5)
RRRRRR4.Cells(AAAZ2, 6) = RRRRRR6.Cells(AAAZ, AAAC + 6)
RRRRRR4.Cells(AAAZ2, 7) = RRRRRR6.Cells(AAAZ, AAAC + 8)
End If
Next SCHOT
AAAZ2 = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row) + 1
RRRRRR4.Cells(AAAZ2, 3) = "Netto:"
RRRRRR4.Cells(AAAZ2 + 1, 3) = "MwSt.:"
RRRRRR4.Cells(AAAZ2 + 2, 3) = "Brutto:"
RRRRRR4.Cells(AAAZ2 + 2, 1) = "_"
RRRRRR4.Cells(AAAZ2, 4) = RRRRRR6.Cells(AAAZ, 363)
RRRRRR4.Cells(AAAZ2 + 1, 4) = RRRRRR6.Cells(AAAZ, 364)
RRRRRR4.Cells(AAAZ2 + 2, 4) = RRRRRR6.Cells(AAAZ, 365)
Exit Sub
EERR:
End Sub
Sub ZZUUFF()
On Error Resume Next
Dim SCHRI As String
Dim TSCH As Long
Dim ††† As Long
SCHRI = ""
SCHRI = RRRRRR2.Name
If SCHRI = "" Then
MsgBox "Fehler im Schritt 3!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = RRRRRR3.Name
If SCHRI = "" Then
MsgBox "Fehler im Schritt 4!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = RRRRRR4.Name
If SCHRI = "" Then
MsgBox "Fehler im Schritt 5!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = RRRRRR5.Name
If SCHRI = "" Then
MsgBox "Fehler im Schritt 6!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = RRRRRR6.Name
If SCHRI = "" Then
MsgBox "Fehler im Schritt 7!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label1.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 8!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ComboBox1.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 9!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label2.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 10!", , "www.excel.npage.de"
End If
For ††† = 3 To 11
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 11!", , "www.excel.npage.de"
End If
Next †††
TSCH = 1
TSCH = Frame1.Left
If TSCH <> 0 Then
MsgBox "Fehler im Schritt 12!", , "www.excel.npage.de"
End If
For ††† = 2 To 3
TSCH = 0
TSCH = Me.Controls("Frame" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 13!", , "www.excel.npage.de"
End If
Next †††
TSCH = 1
TSCH = ListBox1.Left
If TSCH <> 0 Then
MsgBox "Fehler im Schritt 14!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label12.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 15!", , "www.excel.npage.de"
End If
For ††† = 13 To 20
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 16!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = Label21.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 17!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label22.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 18!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ComboBox2.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 19!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label23.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 20!", , "www.excel.npage.de"
End If
For ††† = 24 To 27
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 21!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = TextBox1.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 22!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton1.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 23!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton2.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 24!", , "www.excel.npage.de"
End If
For ††† = 28 To 36
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 25!", , "www.excel.npage.de"
End If
Next †††
For ††† = 3 To 5
TSCH = 0
TSCH = Me.Controls("ComboBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 26!", , "www.excel.npage.de"
End If
Next †††
For ††† = 37 To 41
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 27!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = TextBox2.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 28!", , "www.excel.npage.de"
End If
For ††† = 3 To 4
TSCH = 0
TSCH = Me.Controls("CommandButton" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 29!", , "www.excel.npage.de"
End If
Next †††
For ††† = 42 To 48
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 30!", , "www.excel.npage.de"
End If
Next †††
For ††† = 6 To 7
TSCH = 0
TSCH = Me.Controls("ComboBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 31!", , "www.excel.npage.de"
End If
Next †††
For ††† = 3 To 7
TSCH = 0
TSCH = Me.Controls("TextBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 32!", , "www.excel.npage.de"
End If
Next †††
For ††† = 5 To 6
TSCH = 0
TSCH = Me.Controls("CommandButton" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 33!", , "www.excel.npage.de"
End If
Next †††
For ††† = 7 To 9
TSCH = 0
TSCH = Me.Controls("CommandButton" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 37!", , "www.excel.npage.de"
End If
Next †††
End Sub
Sub ZZZUUFAF()
On Error GoTo ERR
TBB1.BackColor = &HC0FFFF
TBB2.BackColor = &HC0FFFF
KuNr.Enabled = True
KuNr.BackColor = &HC0FFFF
Dim IC As String
IC = CoB1
If CoB1 > "" Then
Sheets(IC).Activate
End If
If ActiveSheet.Name <> "Zäler" And ActiveSheet.Name <> "POMO" Then
Dim AAAZ As Variant
Dim AAAC As Variant
POMO.[a2] = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
POMO.[a3] = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Column
AAAZ = CDbl(POMO.[a2])
AAAC = CDbl(POMO.[a3])
SPALTA1 = ""
SPALTA2 = ""
SPALTA3 = ""
SPALTA4 = ""
SPALTA5 = ""
SPALTA6 = ""
SPALTA7 = ""
SPALTB1 = ""
SPALTB2 = ""
SPALTB3 = ""
SPALTB4 = ""
SPALTB5 = ""
SPALTB6 = ""
SPALTB7 = ""
SPALTC1 = ""
SPALTC2 = ""
SPALTC3 = ""
SPALTC4 = ""
SPALTC5 = ""
SPALTC6 = ""
SPALTC7 = ""
SPALTD1 = ""
SPALTD2 = ""
SPALTD3 = ""
SPALTD4 = ""
SPALTD5 = ""
SPALTD6 = ""
SPALTD7 = ""
SPALTE1 = ""
SPALTE2 = ""
SPALTE3 = ""
SPALTE4 = ""
SPALTE5 = ""
SPALTE6 = ""
SPALTE7 = ""
SPALTF1 = ""
SPALTF2 = ""
SPALTF3 = ""
SPALTF4 = ""
SPALTF5 = ""
SPALTF6 = ""
SPALTF7 = ""
SPALTG1 = ""
SPALTG2 = ""
SPALTG3 = ""
SPALTG4 = ""
SPALTG5 = ""
SPALTG6 = ""
SPALTG7 = ""
SPALTA = ""
SPALTB = ""
SPALTC = ""
SPALTD = ""
SPALTE = ""
SPALTF = ""
SPALTG = ""
KuNr = ""
TBB1.Value = ""
TBB2.Value = ""
TBB3.Value = ""
TBB4.Value = ""
TBB5.Value = ""
TBB6.Value = ""
POMO.[a1] = ""
POMO.[b1] = ""
POMO.[c1] = ""
POMO.[d1] = ""
POMO.[e1] = ""
POMO.[F1] = ""
POMO.[g1] = ""
POMO.[h1] = ""
POMO.[i1] = ""
POMO.[j1] = ""
POMO.[k1] = ""
POMO.[L1] = ""
POMO.[m1] = ""
If POMO.[a2] < 65536 Then
Dim ††† As Variant
If POMO.[a3] = 1 Then
POMO.[a4] = 0
††† = POMO.[a4]
End If
If POMO.[a3] = 7 Then
POMO.[a4] = 6
††† = POMO.[a4]
End If
SPALTA = ActiveSheet.Cells(1, AAAC - †††).Value
SPALTB = ActiveSheet.Cells(1, AAAC + 1).Value
SPALTC = ActiveSheet.Cells(1, AAAC + 2).Value
SPALTD = ActiveSheet.Cells(1, AAAC + 3).Value
SPALTE = ActiveSheet.Cells(1, AAAC + 4).Value
SPALTF = ActiveSheet.Cells(1, AAAC + 5).Value
SPALTG = ActiveSheet.Cells(1, AAAC + 6).Value
If POMO.[a2] > 8 Then
SPALTA1 = ActiveSheet.Cells(AAAZ - 6, AAAC - †††).Value
SPALTB1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 1).Value
SPALTC1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 2).Value
SPALTD1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 3).Value
SPALTE1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 4).Value
SPALTF1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 5).Value
SPALTG1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 6).Value
End If
If POMO.[a2] > 7 Then
SPALTA2 = ActiveSheet.Cells(AAAZ - 5, AAAC - †††).Value
SPALTB2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 1).Value
SPALTC2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 2).Value
SPALTD2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 3).Value
SPALTE2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 4).Value
SPALTF2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 5).Value
SPALTG2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 6).Value
End If
If POMO.[a2] > 6 Then
SPALTA3 = ActiveSheet.Cells(AAAZ - 4, AAAC - †††).Value
SPALTB3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 1).Value
SPALTC3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 2).Value
SPALTD3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 3).Value
SPALTE3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 4).Value
SPALTF3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 5).Value
SPALTG3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 6).Value
End If
If POMO.[a2] > 5 Then
SPALTA4 = ActiveSheet.Cells(AAAZ - 3, AAAC - †††).Value
SPALTB4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 1).Value
SPALTC4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 2).Value
SPALTD4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 3).Value
SPALTE4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 4).Value
SPALTF4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 5).Value
SPALTG4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 6).Value
End If
If POMO.[a2] > 4 Then
SPALTA5 = ActiveSheet.Cells(AAAZ - 2, AAAC - †††).Value
SPALTB5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 1).Value
SPALTC5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 2).Value
SPALTD5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 3).Value
SPALTE5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 4).Value
SPALTF5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 5).Value
SPALTG5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 6).Value
End If
If POMO.[a2] > 3 Then
SPALTA6 = ActiveSheet.Cells(AAAZ - 1, AAAC - †††).Value
SPALTB6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 1).Value
SPALTC6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 2).Value
SPALTD6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 3).Value
SPALTE6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 4).Value
SPALTF6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 5).Value
SPALTG6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 6).Value
End If
If POMO.[a2] > 2 Then
SPALTA7 = ActiveSheet.Cells(AAAZ, AAAC - †††).Value
SPALTB7 = ActiveSheet.Cells(AAAZ, AAAC + 1).Value
SPALTC7 = ActiveSheet.Cells(AAAZ, AAAC + 2).Value
SPALTD7 = ActiveSheet.Cells(AAAZ, AAAC + 3).Value
SPALTE7 = ActiveSheet.Cells(AAAZ, AAAC + 4).Value
SPALTF7 = ActiveSheet.Cells(AAAZ, AAAC + 5).Value
SPALTG7 = ActiveSheet.Cells(AAAZ, AAAC + 6).Value
End If
End If
End If
If ActiveSheet.Name <> "Zäler" And ActiveSheet.Name <> "POMO" Then
TANA = ActiveSheet.Name
End If
Exit Sub
ERR:
End Sub
'''3_1_ R##########