Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen
Liste von Herstellungsschritten und Code
0_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_So funktioniert es
1_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Arbeitsmappe
6_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Tabellenblatt Konten
7_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Tabellenblatt Konto
8_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Label1
9_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Label2
10_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Label3
11_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Label4 - 5
12_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_ComboBox1
13_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_CommandButton1
15_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_CheckBox1
16_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_TextBox ENTS
17_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Frame1
18_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Frame2 Frame3
19_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_ListBox1
20_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Label6
21_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Label7 - Label12
22_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Label13
23_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Label14
24_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_TextBox1
25_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_TextBox2 TextBox3
26_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_ComboBox2
27_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_ComboBox3
28_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_CommandButton2
29_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_CommandButton3
30_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Label15 - Label20
33_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_TextBox4- TextBox5
35_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Label23 - Label28
36_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_Label29 - Label30
37_Lagerverwaltungsprogramm in Excel VBA mit 756 Artikelnummern selber erstellen_TextBox6- TextBox7
'''1_1_ L756##########
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_ L756##########
'''2_1_ L756##########
=SUMME(D3:D758)
'''2_1_ L756##########
'''2_2_ L756##########
=SUMME(E3:E758)
'''2_2_ L756##########
'''3_3_ L756##########
On Error GoTo EERR
Dim SCHO As Long
For SCHO = 1 To 6
ActiveSheet.Cells(1, SCHO).EntireColumn.AutoFit
Next SCHO
Exit Sub
EERR:
'''3_3_ L756##########
'''4_1_ L756#######################
Sub AAMGC()
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 BLFN_Click()
On Error GoTo EERR
Dim ††† As Long
LLLRRR4.Activate
Cells.Select
Selection = ""
Selection.UnMerge
Selection.HorizontalAlignment = xlCenter
LLLRRR4.Range("a13:c13").Merge
LLLRRR4.[a13].HorizontalAlignment = xlLeft
LLLRRR4.[a13] = "Entnahmeschein"
LLLRRR4.[d13] = "Nr.:"
If ENTS.Value <> "" Then
LLLRRR4.[e13] = ENTS.Value
Else:
LLLRRR4.[e13] = LLLRRR5.[a2]
End If
LLLRRR4.[a15] = "Position"
LLLRRR4.[b15] = "Datum"
LLLRRR4.[c15] = "Artikel-Nr."
LLLRRR4.[d15] = "Bezeichnung"
LLLRRR4.[e15] = "Einheit"
LLLRRR4.[f15] = "Menge"
LLLRRR4.[g15] = "Betrag"
LLLRRR4.Range("a13:h15").Font.Bold = True
With ActiveSheet.PageSetup
.RightHeader = LLLRRR4.[e13] & ": &P/&N"
End With
Dim AAAZ As Long
Dim AAAC As Long
Dim AAAF As Object
Dim AAR As Long
Dim AAZZ As Long
Dim SUCHENNN As Variant
Dim SCHET As Long
Dim firstAddress
SCHET = 16
SUCHENNN = "Ent.Sch." & LLLRRR4.[e13]
If SUCHENNN <> "" Then
With LLLRRR3.Range("c9:c1048576")
Set AAAF = .Find(SUCHENNN, LookAt:=xlWhole, LookIn:=xlValues)
If Not AAAF Is Nothing Then
firstAddress = AAAF.Address
Do
AAAZ = CDbl(AAAF.Row)
AAAC = CDbl(AAAF.Column)
Worksheets("Entnahmeschein").Cells(SCHET, 1) = SCHET - 15
Worksheets("Entnahmeschein").Cells(SCHET, 2) = LLLRRR3.Cells(AAAZ, AAAC - 1)
Worksheets("Entnahmeschein").Cells(SCHET, 3) = LLLRRR3.Cells(AAAZ, AAAC + 1)
Worksheets("Entnahmeschein").Cells(SCHET, 4) = LLLRRR3.Cells(AAAZ, AAAC + 2)
Worksheets("Entnahmeschein").Cells(SCHET, 5) = LLLRRR3.Cells(AAAZ, AAAC + 3)
Worksheets("Entnahmeschein").Cells(SCHET, 6) = LLLRRR3.Cells(AAAZ, AAAC + 4) * -1
Worksheets("Entnahmeschein").Cells(SCHET, 7) = LLLRRR3.Cells(AAAZ, AAAC + 5) * -1
Set AAAF = .FindNext(AAAF)
SCHET = SCHET + 1
Loop While Not AAAF Is Nothing And AAAF.Address <> firstAddress
End If
End With
Set AAAF = Nothing
End If
UserForm1.Hide
LLLRRR4.[e13].Select
For ††† = 1 To 7
LLLRRR4.Cells(15, †††).EntireColumn.AutoFit
Next †††
If LLLRRR4.[g16] <= 0 Then
MsgBox "Entnahmeschein " & LLLRRR4.[e13] & " existiert nicht!", 48, "www.excel.npage.de "
End If
Exit Sub
EERR:
End Sub
Private Sub CheckBox1_Click()
If CheckBox1 = True Then
ENTS.Visible = True
End If
If CheckBox1 = False Then
ENTS.Visible = False
ENTS.Value = ""
End If
End Sub
Private Sub ComboBox1_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim strSuchen As Variant
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
Label5.Caption = ""
If ComboBox1.Value <> "" Then
strSuchen = ComboBox1.Value
AAAC = CDbl(LLLRRR2.Range("a3:a758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
Label2.Caption = LLLRRR2.Cells(AAAC, 2)
Label3.Caption = "Bestand: " & LLLRRR2.Cells(AAAC, 4) & " " & LLLRRR2.Cells(AAAC, 3)
Label4.Caption = "Gesamtwert: " & Round(LLLRRR2.Cells(AAAC, 5), 2)
Label5.Caption = "Preis " & "/" & LLLRRR2.Cells(AAAC, 3) & " " & Round(LLLRRR2.Cells(AAAC, 6), 2)
End If
Exit Sub
EERR:
ComboBox1.Value = ""
End Sub
Private Sub ComboBox2_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim strSuchen As Variant
Label13.Caption = ""
Label14.Caption = ""
TextBox2.Value = ""
TextBox3.Value = ""
If ComboBox2.Value <> "" Then
strSuchen = ComboBox2.Value
AAAC = CDbl(LLLRRR2.Range("a3:a758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
ComboBox3.Value = LLLRRR2.Cells(AAAC, 2).Value
Label13.Caption = LLLRRR2.Cells(AAAC, 3)
Label14.Caption = Round(LLLRRR2.Cells(AAAC, 6), 2)
ComboBox1.Value = ComboBox2.Value
ComboBox4.Value = ""
ComboBox6.Value = ""
Else:
ComboBox3.Value = ""
End If
Exit Sub
EERR:
ComboBox2.Value = ""
ComboBox3.Value = ""
End Sub
Private Sub ComboBox3_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim strSuchen As Variant
Label13.Caption = ""
Label14.Caption = ""
TextBox2.Value = ""
TextBox3.Value = ""
If ComboBox3.Value <> "" Then
strSuchen = ComboBox3.Value
AAAC = CDbl(LLLRRR2.Range("b3:b758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
ComboBox2.Value = LLLRRR2.Cells(AAAC, 1).Value
Label13.Caption = LLLRRR2.Cells(AAAC, 3)
Label14.Caption = Round(LLLRRR2.Cells(AAAC, 6), 2)
Else:
ComboBox2.Value = ""
End If
Exit Sub
EERR:
ComboBox2.Value = ""
ComboBox3.Value = ""
End Sub
Private Sub ComboBox4_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim strSuchen As Variant
Label21.Caption = ""
Label22.Caption = ""
TextBox4.Value = ""
TextBox5.Value = ""
If ComboBox4.Value <> "" Then
strSuchen = ComboBox4.Value
AAAC = CDbl(LLLRRR2.Range("a3:a758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
ComboBox5.Value = LLLRRR2.Cells(AAAC, 2).Value
Label21.Caption = LLLRRR2.Cells(AAAC, 3)
Label22.Caption = Round(LLLRRR2.Cells(AAAC, 6), 2)
ComboBox1.Value = ComboBox4.Value
ComboBox2.Value = ""
ComboBox6.Value = ""
Else:
ComboBox5.Value = ""
End If
Exit Sub
EERR:
ComboBox4.Value = ""
ComboBox5.Value = ""
End Sub
Private Sub ComboBox5_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim strSuchen As Variant
Label21.Caption = ""
Label22.Caption = ""
TextBox4.Value = ""
TextBox5.Value = ""
If ComboBox5.Value <> "" Then
strSuchen = ComboBox5.Value
AAAC = CDbl(LLLRRR2.Range("b3:b758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
ComboBox4.Value = LLLRRR2.Cells(AAAC, 1).Value
Label21.Caption = LLLRRR2.Cells(AAAC, 3)
Label22.Caption = Round(LLLRRR2.Cells(AAAC, 6), 2)
Else:
ComboBox4.Value = ""
End If
Exit Sub
EERR:
ComboBox4.Value = ""
ComboBox5.Value = ""
End Sub
Private Sub ComboBox6_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim strSuchen As Variant
Label29.Caption = ""
Label30.Caption = ""
TextBox7.Value = ""
If ComboBox6.Value <> "" Then
strSuchen = ComboBox6.Value
AAAC = CDbl(LLLRRR2.Range("a3:a758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
ComboBox7.Value = LLLRRR2.Cells(AAAC, 2).Value
Label29.Caption = LLLRRR2.Cells(AAAC, 3)
Label30.Caption = Round(LLLRRR2.Cells(AAAC, 6), 2)
ComboBox1.Value = ComboBox6.Value
ComboBox4.Value = ""
ComboBox2.Value = ""
Else:
ComboBox7.Value = ""
End If
Exit Sub
EERR:
ComboBox6.Value = ""
ComboBox7.Value = ""
End Sub
Private Sub ComboBox7_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim strSuchen As Variant
Label29.Caption = ""
Label30.Caption = ""
TextBox7.Value = ""
If ComboBox7.Value <> "" Then
strSuchen = ComboBox7.Value
AAAC = CDbl(LLLRRR2.Range("b3:b758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
ComboBox6.Value = LLLRRR2.Cells(AAAC, 1).Value
Label29.Caption = LLLRRR2.Cells(AAAC, 3)
Label30.Caption = Round(LLLRRR2.Cells(AAAC, 6), 2)
Else:
ComboBox6.Value = ""
End If
Exit Sub
EERR:
ComboBox6.Value = ""
ComboBox7.Value = ""
End Sub
Private Sub CommandButton1_Click()
On Error GoTo EERR
Dim strSuchen As Variant
Dim SCHOT As Long
Dim AAAC As Long
Dim AAAC2 As Long
Dim AAAZ As Long
If ComboBox1 <> "" Then
LLLRRR6.Range("a1:f65530") = ""
strSuchen = ComboBox1.Value
AAAC = CDbl(LLLRRR2.Range("a3:a758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
AAAC2 = 3 + (AAAC - 3) * 5
For SCHOT = 1 To 6
LLLRRR6.Cells(SCHOT, 1) = LLLRRR5.Cells(SCHOT, 2)
Next SCHOT
LLLRRR6.Cells(1, 4) = LLLRRR5.Cells(1, AAAC2)
LLLRRR6.Cells(2, 4) = LLLRRR5.Cells(2, AAAC2)
LLLRRR6.Cells(3, 4) = LLLRRR5.Cells(3, AAAC2)
LLLRRR6.Cells(4, 4) = LLLRRR5.Cells(4, AAAC2 + 3)
LLLRRR6.Cells(5, 5) = LLLRRR5.Cells(5, AAAC2 + 4)
LLLRRR6.Cells(6, 4) = LLLRRR5.Cells(6, AAAC2)
For SCHOT = 1 To 5
LLLRRR6.Cells(8, SCHOT) = LLLRRR5.Cells(11, SCHOT - 1 + AAAC2)
Next SCHOT
For SCHOT = 1 To 10000
If LLLRRR5.Cells(SCHOT - 1 + 12, AAAC2) <> "" Then
AAAZ = CDbl(LLLRRR6.Cells(Rows.Count, 1).End(xlUp).Row) + 1
LLLRRR6.Cells(AAAZ, 1) = LLLRRR5.Cells(SCHOT - 1 + 12, AAAC2)
LLLRRR6.Cells(AAAZ, 2) = LLLRRR5.Cells(SCHOT - 1 + 12, AAAC2 + 1)
LLLRRR6.Cells(AAAZ, 3) = LLLRRR5.Cells(SCHOT - 1 + 12, AAAC2 + 2)
LLLRRR6.Cells(AAAZ, 4) = LLLRRR5.Cells(SCHOT - 1 + 12, AAAC2 + 3)
LLLRRR6.Cells(AAAZ, 5) = LLLRRR5.Cells(SCHOT - 1 + 12, AAAC2 + 4)
End If
Next SCHOT
LLLRRR6.Name = "Nr_" & LLLRRR6.[d1]
LLLRRR6.Activate
LLLRRR6.[d1].Select
ActiveSheet.Cells(Rows.Count, 1).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 2).ColumnWidth = 20
ActiveSheet.Cells(Rows.Count, 3).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 4).ColumnWidth = 20
ActiveSheet.Cells(Rows.Count, 5).EntireColumn.AutoFit
With ActiveSheet.PageSetup
.RightHeader = ActiveSheet.Name & ": &P/&N"
End With
LLLRRR6.Activate
Unload UserForm1
End If
Exit Sub
EERR:
End Sub
Private Sub CommandButton2_Click()
On Error GoTo EERR
TextBox2.SetFocus
TextBox3.SetFocus
TextBox1.SetFocus
If LLLRRR3.[a65530] <> "" Then
MsgBox "Das Grundbuch ist voll!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If TextBox1.Value = "" Then
MsgBox "Beleg ist nicht eingetragen!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If ComboBox2.Value = "" Then
MsgBox "Artikelnummer ist nicht eingetragen!", 48, "www.excel.npage.de "
ComboBox2.SetFocus
Exit Sub
End If
Dim AAAZ As Long
Dim AAAR As Long
Dim AAAZ2 As Long
Dim strSuchen As Variant
LLLRRR3.[a11] = 0
AAAZ = CDbl(LLLRRR3.Cells(Rows.Count, 1).End(xlUp).Row) + 1
LLLRRR3.Cells(AAAZ, 1) = LLLRRR3.Cells(AAAZ - 1, 1) + 1
LLLRRR3.Cells(AAAZ, 1).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 2) = Date
LLLRRR3.Cells(AAAZ, 2) = Format(Date, "dd.mm.yyyy")
LLLRRR3.Cells(AAAZ, 2).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 3) = TextBox1.Value
LLLRRR3.Cells(AAAZ, 3).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 4) = ComboBox2.Value
LLLRRR3.Cells(AAAZ, 4).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 5) = ComboBox3.Value
LLLRRR3.Cells(AAAZ, 5).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 6) = Label13.Caption
LLLRRR3.Cells(AAAZ, 6).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 7) = CDbl(TextBox2.Value)
LLLRRR3.Cells(AAAZ, 7).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 8) = Round(CDbl(TextBox3.Value), 2)
LLLRRR3.Cells(AAAZ, 8).HorizontalAlignment = xlCenter
strSuchen = ComboBox1.Value
AAAZ2 = CDbl(LLLRRR2.Range("a3:a758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
AAAR = 3 + (AAAZ2 - 3) * 5
LLLRRR5.Cells(AAAZ, AAAR) = LLLRRR3.Cells(AAAZ, 1)
LLLRRR5.Cells(AAAZ, AAAR).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 1) = LLLRRR3.Cells(AAAZ, 2)
LLLRRR5.Cells(AAAZ, AAAR + 1) = Format(Date, "dd.mm.yyyy")
LLLRRR5.Cells(AAAZ, AAAR + 1).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 2) = LLLRRR3.Cells(AAAZ, 3)
LLLRRR5.Cells(AAAZ, AAAR + 2).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 3) = LLLRRR3.Cells(AAAZ, 7)
LLLRRR5.Cells(AAAZ, AAAR + 3).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 4) = LLLRRR3.Cells(AAAZ, 8)
LLLRRR5.Cells(AAAZ, AAAR + 4).HorizontalAlignment = xlCenter
LLLRRR5.Cells(4, AAAR + 3).FormulaR1C1 = "=SUM(R[8]C:R[65526]C)"
LLLRRR5.Cells(5, AAAR + 4).FormulaR1C1 = "=SUM(R[7]C:R[65525]C)"
LLLRRR5.Cells(4, AAAR + 3) = LLLRRR5.Cells(4, AAAR + 3).Value
LLLRRR5.Cells(5, AAAR + 4) = LLLRRR5.Cells(5, AAAR + 4).Value
If LLLRRR5.Cells(4, AAAR + 3) > 0 Then
LLLRRR5.Cells(6, AAAR) = Round(LLLRRR5.Cells(5, AAAR + 4) / LLLRRR5.Cells(4, AAAR + 3), 2)
Else:
LLLRRR5.Cells(6, AAAR) = 0
End If
Dim SCHOT As Integer
For SCHOT = 3 To 758
If LLLRRR5.Cells(4, 3 + ((SCHOT - 3) * 5) + 3) <> LLLRRR2.Cells(SCHOT, 4) Then
LLLRRR2.Cells(SCHOT, 4) = LLLRRR5.Cells(4, 3 + ((SCHOT - 3) * 5) + 3)
End If
If LLLRRR5.Cells(5, 3 + ((SCHOT - 3) * 5) + 4) <> LLLRRR2.Cells(SCHOT, 5) Then
LLLRRR2.Cells(SCHOT, 5) = LLLRRR5.Cells(5, 3 + ((SCHOT - 3) * 5) + 4)
End If
If LLLRRR5.Cells(6, 3 + ((SCHOT - 3) * 5)) <> LLLRRR2.Cells(SCHOT, 6) Then
LLLRRR2.Cells(SCHOT, 6) = LLLRRR5.Cells(6, 3 + ((SCHOT - 3) * 5))
End If
Next SCHOT
With LLLRRR3
ListBox1.RowSource = .Range(.Cells(11, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 8)).Address(External:=True)
ListBox1.ListIndex = ListBox1.ListCount - 1
End With
ComboBox1.Value = "_"
ComboBox1.Value = ComboBox2.Value
TextBox2.Value = ""
TextBox3.Value = ""
Exit Sub
EERR:
End Sub
Private Sub CommandButton3_Click()
On Error GoTo EERR
TextBox1.Value = ""
ComboBox2.Value = ""
Exit Sub
EERR:
End Sub
Private Sub CommandButton4_Click()
On Error GoTo EERR
TextBox4.SetFocus
TextBox5.SetFocus
ComboBox4.SetFocus
If LLLRRR3.[a65530] <> "" Then
MsgBox "Das Grundbuch ist voll!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If ComboBox4.Value = "" Then
MsgBox "Artikelnummer ist nicht eingetragen!", 48, "www.excel.npage.de "
ComboBox4.SetFocus
Exit Sub
End If
If TextBox4.Value = "" Then
MsgBox "Menge ist nicht eingetragen!", 48, "www.excel.npage.de "
TextBox4.SetFocus
Exit Sub
End If
Dim AAAZ As Long
Dim AAAR As Long
Dim ††† As Long
Dim strSuchen As Variant
strSuchen = ComboBox1.Value
††† = CDbl(LLLRRR2.Range("a3:a758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
If LLLRRR2.Cells(†††, 4) <= 0 Then
MsgBox "Lagerbestand von dem Artikel ist Null!", 48, "www.excel.npage.de "
ComboBox4.SetFocus
Exit Sub
End If
If LLLRRR2.Cells(†††, 4) - CDbl(TextBox4) < 0 Then
MsgBox "Artikelbestand ist weniger als Entnahmemenge!", 48, "www.excel.npage.de "
TextBox4.SetFocus
Exit Sub
End If
LLLRRR3.[a11] = 0
AAAZ = CDbl(LLLRRR3.Cells(Rows.Count, 1).End(xlUp).Row) + 1
LLLRRR3.Cells(AAAZ, 1) = LLLRRR3.Cells(AAAZ - 1, 1) + 1
LLLRRR3.Cells(AAAZ, 1).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 2) = Date
LLLRRR3.Cells(AAAZ, 2) = Format(Date, "dd.mm.yyyy")
LLLRRR3.Cells(AAAZ, 2).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 3) = "Ent.Sch." & LLLRRR5.[a2]
LLLRRR3.Cells(AAAZ, 3).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 4) = ComboBox4.Value
LLLRRR3.Cells(AAAZ, 4).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 5) = ComboBox5.Value
LLLRRR3.Cells(AAAZ, 5).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 6) = Label21.Caption
LLLRRR3.Cells(AAAZ, 6).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 7) = CDbl(TextBox4.Value) * -1
LLLRRR3.Cells(AAAZ, 7).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 8) = CDbl(TextBox4.Value) * CDbl(Label22.Caption)
LLLRRR3.Cells(AAAZ, 8) = Round(LLLRRR3.Cells(AAAZ, 8), 2) * -1
LLLRRR3.Activate
LLLRRR3.Cells(AAAZ, 8).Select
LLLRRR3.Cells(AAAZ, 8).HorizontalAlignment = xlCenter
AAAR = 3 + (††† - 3) * 5
LLLRRR5.Cells(AAAZ, AAAR) = LLLRRR3.Cells(AAAZ, 1)
LLLRRR5.Cells(AAAZ, AAAR).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 1) = LLLRRR3.Cells(AAAZ, 2)
LLLRRR5.Cells(AAAZ, AAAR + 1) = Format(Date, "dd.mm.yyyy")
LLLRRR5.Cells(AAAZ, AAAR + 1).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 2) = LLLRRR3.Cells(AAAZ, 3)
LLLRRR5.Cells(AAAZ, AAAR + 2).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 3) = LLLRRR3.Cells(AAAZ, 7)
LLLRRR5.Cells(AAAZ, AAAR + 3).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 4) = LLLRRR3.Cells(AAAZ, 8)
LLLRRR5.Cells(AAAZ, AAAR + 4).HorizontalAlignment = xlCenter
LLLRRR5.Cells(4, AAAR + 3).FormulaR1C1 = "=SUM(R[8]C:R[65526]C)"
LLLRRR5.Cells(5, AAAR + 4).FormulaR1C1 = "=SUM(R[7]C:R[65525]C)"
LLLRRR5.Cells(4, AAAR + 3) = LLLRRR5.Cells(4, AAAR + 3).Value
LLLRRR5.Cells(5, AAAR + 4) = LLLRRR5.Cells(5, AAAR + 4).Value
If LLLRRR5.Cells(4, AAAR + 3) > 0 Then
LLLRRR5.Cells(6, AAAR) = Round(LLLRRR5.Cells(5, AAAR + 4) / LLLRRR5.Cells(4, AAAR + 3), 2)
Else:
LLLRRR5.Cells(6, AAAR) = 0
End If
Dim SCHOT As Integer
For SCHOT = 3 To 758
If LLLRRR5.Cells(4, 3 + ((SCHOT - 3) * 5) + 3) <> LLLRRR2.Cells(SCHOT, 4) Then
LLLRRR2.Cells(SCHOT, 4) = LLLRRR5.Cells(4, 3 + ((SCHOT - 3) * 5) + 3)
End If
If LLLRRR5.Cells(5, 3 + ((SCHOT - 3) * 5) + 4) <> LLLRRR2.Cells(SCHOT, 5) Then
LLLRRR2.Cells(SCHOT, 5) = LLLRRR5.Cells(5, 3 + ((SCHOT - 3) * 5) + 4)
End If
If LLLRRR5.Cells(6, 3 + ((SCHOT - 3) * 5)) <> LLLRRR2.Cells(SCHOT, 6) Then
LLLRRR2.Cells(SCHOT, 6) = LLLRRR5.Cells(6, 3 + ((SCHOT - 3) * 5))
End If
Next SCHOT
With LLLRRR3
ListBox1.RowSource = .Range(.Cells(11, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 8)).Address(External:=True)
ListBox1.ListIndex = ListBox1.ListCount - 1
End With
ComboBox1.Value = "_"
ComboBox1.Value = ComboBox4.Value
TextBox4.Value = ""
TextBox5.Value = ""
Exit Sub
EERR:
End Sub
Sub CommaaandButton5()
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
Sub trkrch()
On Error GoTo EERR
If LLLRRR1.Cells(1961, 1962) <> Date Then
LLLRRR1.Cells(1961, 1962) = Date
ActiveWorkbook.FollowHyperlink Address:="https://youtu.be/opIEJOuozH8", NewWindow:=True
End If
Exit Sub
EERR:
End Sub
Private Sub CommandButton5_Click()
On Error GoTo EERR
Dim AAAA As Variant
LLLRRR4.Activate
Unload Me
AAAA = MsgBox("Möchten Sie den Inhalt des Entnahmescheins löschen und neue Entnahmescheinnummer vergeben?", vbYesNo, "www.excel.npage.de Entnahmescheinnummer")
If AAAA = vbYes Then
ActiveSheet.Range("a16:g65536").Value = ""
LLLRRR5.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = 1
LLLRRR5.[a2].FormulaR1C1 = "=SUM(R[1]C:R[65534]C)"
LLLRRR5.[a2] = LLLRRR5.[a2]
ActiveSheet.[e13] = LLLRRR5.[a2]
If LLLRRR5.[a65522] > 0 Then
LLLRRR5.Range("a2:a65525").Value = ""
LLLRRR5.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = 1
ActiveSheet.[e13] = LLLRRR5.[a2]
End If
End If
Exit Sub
EERR:
End Sub
Private Sub CommandButton6_Click()
On Error GoTo EERR
TextBox7.SetFocus
TextBox6.SetFocus
If LLLRRR3.[a65530] <> "" Then
MsgBox "Das Grundbuch ist voll!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If TextBox6.Value = "" Then
MsgBox "Beleg ist nicht eingetragen!", 48, "www.excel.npage.de "
TextBox6.SetFocus
Exit Sub
End If
If ComboBox6.Value = "" Then
MsgBox "Artikelnummer ist nicht eingetragen!", 48, "www.excel.npage.de "
ComboBox6.SetFocus
Exit Sub
End If
If TextBox7.Value = "" Then
MsgBox "Betrag ist nicht eingetragen!", 48, "www.excel.npage.de "
TextBox7.SetFocus
Exit Sub
End If
Dim AAAZ As Long
Dim AAAR As Long
Dim AAAZ2 As Long
Dim strSuchen As Variant
LLLRRR3.[a11] = 0
AAAZ = CDbl(LLLRRR3.Cells(Rows.Count, 1).End(xlUp).Row) + 1
LLLRRR3.Cells(AAAZ, 1) = LLLRRR3.Cells(AAAZ - 1, 1) + 1
LLLRRR3.Cells(AAAZ, 1).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 2) = Date
LLLRRR3.Cells(AAAZ, 2) = Format(Date, "dd.mm.yyyy")
LLLRRR3.Cells(AAAZ, 2).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 3) = TextBox6.Value
LLLRRR3.Cells(AAAZ, 3).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 4) = ComboBox6.Value
LLLRRR3.Cells(AAAZ, 4).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 5) = ComboBox7.Value
LLLRRR3.Cells(AAAZ, 5).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 6) = Label29.Caption
LLLRRR3.Cells(AAAZ, 6).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 8) = Round(CDbl(TextBox7.Value), 2) * -1
LLLRRR3.Cells(AAAZ, 8).HorizontalAlignment = xlCenter
strSuchen = ComboBox1.Value
AAAZ2 = CDbl(LLLRRR2.Range("a3:a758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
AAAR = 3 + (AAAZ2 - 3) * 5
LLLRRR5.Cells(AAAZ, AAAR) = LLLRRR3.Cells(AAAZ, 1)
LLLRRR5.Cells(AAAZ, AAAR).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 1) = LLLRRR3.Cells(AAAZ, 2)
LLLRRR5.Cells(AAAZ, AAAR + 1) = Format(Date, "dd.mm.yyyy")
LLLRRR5.Cells(AAAZ, AAAR + 1).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 2) = LLLRRR3.Cells(AAAZ, 3)
LLLRRR5.Cells(AAAZ, AAAR + 2).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 4) = LLLRRR3.Cells(AAAZ, 8)
LLLRRR5.Cells(AAAZ, AAAR + 4).HorizontalAlignment = xlCenter
LLLRRR5.Cells(4, AAAR + 3).FormulaR1C1 = "=SUM(R[8]C:R[65526]C)"
LLLRRR5.Cells(5, AAAR + 4).FormulaR1C1 = "=SUM(R[7]C:R[65525]C)"
LLLRRR5.Cells(4, AAAR + 3) = LLLRRR5.Cells(4, AAAR + 3).Value
LLLRRR5.Cells(5, AAAR + 4) = LLLRRR5.Cells(5, AAAR + 4).Value
If LLLRRR5.Cells(4, AAAR + 3) > 0 Then
LLLRRR5.Cells(6, AAAR) = Round(LLLRRR5.Cells(5, AAAR + 4) / LLLRRR5.Cells(4, AAAR + 3), 2)
Else:
LLLRRR5.Cells(6, AAAR) = 0
End If
Dim SCHOT As Integer
For SCHOT = 3 To 758
If LLLRRR5.Cells(4, 3 + ((SCHOT - 3) * 5) + 3) <> LLLRRR2.Cells(SCHOT, 4) Then
LLLRRR2.Cells(SCHOT, 4) = LLLRRR5.Cells(4, 3 + ((SCHOT - 3) * 5) + 3)
End If
If LLLRRR5.Cells(5, 3 + ((SCHOT - 3) * 5) + 4) <> LLLRRR2.Cells(SCHOT, 5) Then
LLLRRR2.Cells(SCHOT, 5) = LLLRRR5.Cells(5, 3 + ((SCHOT - 3) * 5) + 4)
End If
If LLLRRR5.Cells(6, 3 + ((SCHOT - 3) * 5)) <> LLLRRR2.Cells(SCHOT, 6) Then
LLLRRR2.Cells(SCHOT, 6) = LLLRRR5.Cells(6, 3 + ((SCHOT - 3) * 5))
End If
Next SCHOT
With LLLRRR3
ListBox1.RowSource = .Range(.Cells(11, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 8)).Address(External:=True)
ListBox1.ListIndex = ListBox1.ListCount - 1
End With
ComboBox1.Value = "_"
ComboBox1.Value = ComboBox6.Value
TextBox7.Value = ""
Exit Sub
EERR:
End Sub
Private Sub CommandButton7_Click()
On Error GoTo EERR
ComboBox6.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
Exit Sub
EERR:
End Sub
Private Sub EELL_Click()
On Error GoTo EERR
LLLRRR3.Activate
Unload Me
Dim AAAA As Variant
Dim strSuchen As Variant
Dim strFrage As Double
AAAA = MsgBox("" & "Moechten Sie wirklich einer Eintrag loeschen?" _
& "", vbYesNo, "www.excel.npage.de Loeschen")
If AAAA = vbNo Then
Exit Sub
Else
End If
strSuchen = Application.InputBox _
("Kennwort:", "www.excel.npage.de Loeschen ")
If strSuchen <> 3 Then
MS = MsgBox("Das Kennwort ist falsch", , "www.excel.npage.de Loeschen")
Exit Sub
Else
End If
strSuchen = Application.InputBox _
("Geben Sie bitte gewuenschte ID-Nr. ein", "www.excel.npage.de Loeschen ")
If strSuchen = False Then
AAAA = MsgBox("Diese ID-Nr. ist nicht vorhanden", , "www.excel.npage.de Loeschen")
Exit Sub
End If
If strSuchen = 0 Then
AAAA = MsgBox("Diese ID-Nr.(0) ist nicht vorhanden", , "www.excel.npage.de Loeschen")
Exit Sub
End If
If strSuchen = "" Then
AAAA = MsgBox("Geben Sie bitte ID-Nr. ein", , "www.excel.npage.de Loeschen")
Exit Sub
End If
If strSuchen = False Then
Exit Sub
Else
ActiveSheet.Range("a11:a65530").Cells.Find(What:=strSuchen, LookAt:=xlWhole).Activate
strFrage = MsgBox("Soll dieser Eintrag: " & _
"ID-Nr.-" & ActiveCell.Value & "; " & _
"Datum-" & ActiveCell.Offset(0, 1) & "; " & _
"Beleg-" & ActiveCell.Offset(0, 2) & "; " & _
"wirklich geloescht werden?", _
vbYesNo, "www.excel.npage.de Loeschen")
If strFrage = vbNo Then
Exit Sub
ElseIf strFrage = vbYes Then
Dim AAAZ As Long
Dim AAAZ2 As Long
Dim AAAR As Long
AAAZ = CDbl(ActiveCell.Row)
AAAZ2 = CDbl(LLLRRR2.Range("a3:a758").Find(What:=LLLRRR3.Cells(AAAZ, 4), LookAt:=xlWhole).Row)
AAAR = 3 + (AAAZ2 - 3) * 5
LLLRRR5.Cells(AAAZ, AAAR) = ""
LLLRRR5.Cells(AAAZ, AAAR + 1) = ""
LLLRRR5.Cells(AAAZ, AAAR + 2) = ""
LLLRRR5.Cells(AAAZ, AAAR + 3) = ""
LLLRRR5.Cells(AAAZ, AAAR + 4) = ""
LLLRRR5.Cells(4, AAAR + 3).FormulaR1C1 = "=SUM(R[8]C:R[65526]C)"
LLLRRR5.Cells(5, AAAR + 4).FormulaR1C1 = "=SUM(R[7]C:R[65525]C)"
LLLRRR5.Cells(4, AAAR + 3) = LLLRRR5.Cells(4, AAAR + 3).Value
LLLRRR5.Cells(5, AAAR + 4) = LLLRRR5.Cells(5, AAAR + 4).Value
If LLLRRR5.Cells(4, AAAR + 3) > 0 Then
LLLRRR5.Cells(6, AAAR) = Round(LLLRRR5.Cells(5, AAAR + 4) / LLLRRR5.Cells(4, AAAR + 3), 2)
Else:
LLLRRR5.Cells(6, AAAR) = 0
End If
ActiveCell.EntireRow.Delete
LLLRRR5.Activate
LLLRRR5.Cells(AAAZ, AAAR).Select
ActiveCell.EntireRow.Delete
AAAA = MsgBox("Diese ID-Nr. ist nicht vorhanden!", , "www.excel.npage.de Loeschen")
End If
End If
LLLRRR1.Activate
Exit Sub
EERR:
LLLRRR1.Activate
AAAA = MsgBox("Diese ID-Nr. ist nicht vorhanden!", , "www.excel.npage.de Loeschen")
End Sub
Private Sub AALL_Click()
On Error GoTo EERR
Unload Me
Dim AAAA As Variant
AAAA = MsgBox("" & "Moechten Sie wirklich alle Buchungssaetze 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
LLLRRR3.Range("a12:h65530") = ""
LLLRRR4.Range("a16:i65530") = ""
LLLRRR5.Range("c12:eol65530") = ""
LLLRRR5.Range("c1:eol10") = ""
LLLRRR5.Range("a2:a65525").Value = ""
LLLRRR5.[a2] = 1
LLLRRR5.[a3] = 1
MsgBox "Alles ist geloescht", 48, "www.excel.npage.de "
EERR:
End Sub
Private Sub ENTS_Change()
On Error GoTo EERR
If ENTS.Value <> "" Then
BLFN.BackColor = &HFF00&
Else:
BLFN.BackColor = &HFFFF&
End If
Exit Sub
EERR:
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
If TextBox2.Value > 0 Then
TextBox2.Value = CDbl(TextBox2.Value) * 1
End If
If TextBox2.Value < 0 Then
TextBox1.Value = ""
TextBox2.Value = ""
End If
Exit Sub
EERR:
TextBox2.Value = ""
TextBox1.Value = ""
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
If TextBox3.Value > 0 Then
TextBox3.Value = CDbl(TextBox3.Value) * 1
End If
If TextBox3.Value < 0 Then
TextBox1.Value = ""
TextBox3.Value = ""
End If
Exit Sub
EERR:
TextBox3.Value = ""
TextBox1.Value = ""
End Sub
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
If TextBox4.Value > 0 Then
TextBox5.Value = CDbl(TextBox4.Value) * CDbl(Label22.Caption)
End If
If TextBox4.Value <= 0 Then
TextBox4.Value = ""
End If
Exit Sub
EERR:
TextBox4.Value = ""
End Sub
Private Sub TextBox7_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
If TextBox7.Value > 0 Then
TextBox7.Value = CDbl(TextBox7.Value) * 1
End If
If TextBox7.Value < 0 Then
TextBox7.Value = ""
End If
Exit Sub
EERR:
TextBox7.Value = ""
End Sub
Private Sub UserForm_Initialize()
LLLRRR5.[a3] = 1
Call ZZUUFF
On Error GoTo EERR
With UserForm1
.Height = 431
.Width = 600
End With
Dim SCHOT As Integer
For SCHOT = 3 To 758
If LLLRRR2.Cells(SCHOT, 1) <> LLLRRR5.Cells(1, 3 + ((SCHOT - 3) * 5)) Then
LLLRRR5.Cells(1, 3 + ((SCHOT - 3) * 5)) = LLLRRR2.Cells(SCHOT, 1)
End If
If LLLRRR2.Cells(SCHOT, 2) <> LLLRRR5.Cells(2, 3 + ((SCHOT - 3) * 5)) Then
LLLRRR5.Cells(2, 3 + ((SCHOT - 3) * 5)) = LLLRRR2.Cells(SCHOT, 2)
End If
If LLLRRR2.Cells(SCHOT, 3) <> LLLRRR5.Cells(3, 3 + ((SCHOT - 3) * 5)) Then
LLLRRR5.Cells(3, 3 + ((SCHOT - 3) * 5)) = LLLRRR2.Cells(SCHOT, 3)
End If
If LLLRRR5.Cells(4, 3 + ((SCHOT - 3) * 5) + 3) <> LLLRRR2.Cells(SCHOT, 4) Then
LLLRRR2.Cells(SCHOT, 4) = LLLRRR5.Cells(4, 3 + ((SCHOT - 3) * 5) + 3)
End If
If LLLRRR5.Cells(5, 3 + ((SCHOT - 3) * 5) + 4) <> LLLRRR2.Cells(SCHOT, 5) Then
LLLRRR2.Cells(SCHOT, 5) = LLLRRR5.Cells(5, 3 + ((SCHOT - 3) * 5) + 4)
End If
If LLLRRR5.Cells(6, 3 + ((SCHOT - 3) * 5)) <> LLLRRR2.Cells(SCHOT, 6) Then
LLLRRR2.Cells(SCHOT, 6) = LLLRRR5.Cells(6, 3 + ((SCHOT - 3) * 5))
End If
Next SCHOT
With LLLRRR2
ComboBox1.RowSource = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
With LLLRRR3
ListBox1.RowSource = .Range(.Cells(11, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 8)).Address(External:=True)
ListBox1.ListIndex = ListBox1.ListCount - 1
End With
With LLLRRR2
ComboBox2.RowSource = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
With LLLRRR2
ComboBox3.RowSource = .Range(.Cells(3, 2), .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 2)).Address(External:=True)
End With
With LLLRRR2
ComboBox4.RowSource = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
With LLLRRR2
ComboBox5.RowSource = .Range(.Cells(3, 2), .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 2)).Address(External:=True)
End With
With LLLRRR2
ComboBox6.RowSource = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
Call trkrch
With LLLRRR2
ComboBox7.RowSource = .Range(.Cells(3, 2), .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 2)).Address(External:=True)
End With
If LLLRRR5.[a2] = "" Then
LLLRRR5.[a2] = 1
End If
ENTSN.Caption = LLLRRR5.[a2]
Exit Sub
EERR:
End Sub
Sub ZZUUFF()
On Error Resume Next
Dim SCHRI As String
Dim TSCH As Long
Dim ††† As Long
SCHRI = ""
SCHRI = LLLRRR2.Name
If SCHRI = "" Then
MsgBox "Fehler im Schritt 3!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLRRR3.Name
If SCHRI = "" Then
MsgBox "Fehler im Schritt 4!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLRRR4.Name
If SCHRI <> "Entnahmeschein" Then
MsgBox "Fehler im Schritt 5!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLRRR5.Name
If SCHRI = "" Then
MsgBox "Fehler im Schritt 6!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLRRR6.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 = Label2.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 9!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label3.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 10!", , "www.excel.npage.de"
End If
For ††† = 4 To 5
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 = 0
TSCH = ComboBox1.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 12!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton1.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 13!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = EELL.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 14!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = AALL.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 14!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = BLFN.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 14!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CheckBox1.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 15!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ENTS.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 16!", , "www.excel.npage.de"
End If
For ††† = 1 To 3
TSCH = 1
TSCH = Me.Controls("Frame" & CStr(†††)).Left
If TSCH = 1 Then
MsgBox "Fehler im Schritt 17-18!", , "www.excel.npage.de"
End If
Next †††
TSCH = 11
TSCH = ListBox1.Left
If TSCH = 11 Then
MsgBox "Fehler im Schritt 19!", , "www.excel.npage.de"
End If
For ††† = 6 To 12
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 20-21!", , "www.excel.npage.de"
End If
Next †††
For ††† = 13 To 14
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 22-23!", , "www.excel.npage.de"
End If
Next †††
For ††† = 1 To 3
TSCH = 0
TSCH = Me.Controls("TextBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 24-25!", , "www.excel.npage.de"
End If
Next †††
For ††† = 2 To 3
TSCH = 0
TSCH = Me.Controls("ComboBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 26-27!", , "www.excel.npage.de"
End If
Next †††
For ††† = 2 To 3
TSCH = 0
TSCH = Me.Controls("CommandButton" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 28-29!", , "www.excel.npage.de"
End If
Next †††
For ††† = 15 To 20
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 ††† = 21 To 22
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 31!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = ENTSN.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 31!", , "www.excel.npage.de"
End If
For ††† = 4 To 5
TSCH = 0
TSCH = Me.Controls("ComboBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 32!", , "www.excel.npage.de"
End If
Next †††
For ††† = 4 To 5
TSCH = 0
TSCH = Me.Controls("TextBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 33!", , "www.excel.npage.de"
End If
Next †††
For ††† = 4 To 5
TSCH = 0
TSCH = Me.Controls("CommandButton" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 34!", , "www.excel.npage.de"
End If
Next †††
For ††† = 23 To 28
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 35!", , "www.excel.npage.de"
End If
Next †††
For ††† = 29 To 30
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 36!", , "www.excel.npage.de"
End If
Next †††
For ††† = 6 To 7
TSCH = 0
TSCH = Me.Controls("TextBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 37!", , "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 38!", , "www.excel.npage.de"
End If
Next †††
For ††† = 6 To 7
TSCH = 0
TSCH = Me.Controls("CommandButton" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 39!", , "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
'''4_1_ L756#######################