Create warehouse management program in Excel VBA with 756 article numbers yourself
List of manufacturing steps and code
0_Create warehouse management program in Excel VBA with 756 article numbers yourself_How it works
1_Create warehouse management program in Excel VBA with 756 article numbers yourself_Workbook
3_Create warehouse management program in Excel VBA with 756 article numbers yourself_Sheet article
4_Create warehouse management program in Excel VBA with 756 article numbers yourself_Sheet Journal
6_Create warehouse management program in Excel VBA with 756 article numbers yourself_Sheet Accounts
7_Create warehouse management program in Excel VBA with 756 article numbers yourself_Sheet Account
8_Create warehouse management program in Excel VBA with 756 article numbers yourself_Label1
9_Create warehouse management program in Excel VBA with 756 article numbers yourself_Label2
10_Create warehouse management program in Excel VBA with 756 article numbers yourself_Label3
11_Create warehouse management program in Excel VBA with 756 article numbers yourself_Label4 - 5
12_Create warehouse management program in Excel VBA with 756 article numbers yourself_ComboBox1
13_Create warehouse management program in Excel VBA with 756 article numbers yourself_CommandButton1
15_Create warehouse management program in Excel VBA with 756 article numbers yourself_CheckBox1
16_Create warehouse management program in Excel VBA with 756 article numbers yourself_TextBox ENTS
17_Create warehouse management program in Excel VBA with 756 article numbers yourself_Frame1
18_Create warehouse management program in Excel VBA with 756 article numbers yourself_Frame2 Frame3
19_Create warehouse management program in Excel VBA with 756 article numbers yourself_ListBox1
20_Create warehouse management program in Excel VBA with 756 article numbers yourself_Label6
22_Create warehouse management program in Excel VBA with 756 article numbers yourself_Label13
23_Create warehouse management program in Excel VBA with 756 article numbers yourself_Label14
24_Create warehouse management program in Excel VBA with 756 article numbers yourself_TextBox1
26_Create warehouse management program in Excel VBA with 756 article numbers yourself_ComboBox2
27_Create warehouse management program in Excel VBA with 756 article numbers yourself_ComboBox3
28_Create warehouse management program in Excel VBA with 756 article numbers yourself_CommandButton2
29_Create warehouse management program in Excel VBA with 756 article numbers yourself_CommandButton3
'''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##########
=SUM(D3:D758)
'''2_1_ L756##########
'''2_2_ L756##########
=SUM(E3:E758)
'''2_2_ L756##########
'''3_3_ L756##########
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] = "Removal certificate"
LLLRRR4.[d13] = "No.:"
If ENTS.Value <> "" Then
LLLRRR4.[e13] = ENTS.Value
Else:
LLLRRR4.[e13] = LLLRRR5.[a2]
End If
LLLRRR4.[a15] = "Position"
LLLRRR4.[b15] = "Date"
LLLRRR4.[c15] = "Article No."
LLLRRR4.[d15] = "Discription"
LLLRRR4.[e15] = "Until"
LLLRRR4.[f15] = "Quantity"
LLLRRR4.[g15] = "Amount"
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 = "Re:Cer." & 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)
LLLRRR4.Cells(SCHET, 1) = SCHET - 15
LLLRRR4.Cells(SCHET, 2) = LLLRRR3.Cells(AAAZ, AAAC - 1)
LLLRRR4.Cells(SCHET, 3) = LLLRRR3.Cells(AAAZ, AAAC + 1)
LLLRRR4.Cells(SCHET, 4) = LLLRRR3.Cells(AAAZ, AAAC + 2)
LLLRRR4.Cells(SCHET, 5) = LLLRRR3.Cells(AAAZ, AAAC + 3)
LLLRRR4.Cells(SCHET, 6) = LLLRRR3.Cells(AAAZ, AAAC + 4) * -1
LLLRRR4.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 "Removal certificate " & LLLRRR4.[e13] & " does not exist!", 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 = "Quantity: " & LLLRRR2.Cells(AAAC, 4) & " " & LLLRRR2.Cells(AAAC, 3)
Label4.Caption = "Total value: " & Round(LLLRRR2.Cells(AAAC, 5), 2)
Label5.Caption = "Price " & "/" & 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 = "No_" & 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 "The Journal is full!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If TextBox1.Value = "" Then
MsgBox "Document is not registered!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If ComboBox2.Value = "" Then
MsgBox "Article number is not registered!", 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 "The Journal is full!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If ComboBox4.Value = "" Then
MsgBox "Article number is not registered!", 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 "Stock of the item is zero!", 48, "www.excel.npage.de "
ComboBox4.SetFocus
Exit Sub
End If
If LLLRRR2.Cells(†††, 4) - CDbl(TextBox4) < 0 Then
MsgBox "Article inventory is less than withdrawal amount!", 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) = "Re:Cer." & 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/_LfBugLBJe0", 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("Would you like to delete the contents of the withdrawal form and issue a new withdrawal number?", 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 "The Journal is full!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If TextBox6.Value = "" Then
MsgBox "Document is not registered!", 48, "www.excel.npage.de "
TextBox6.SetFocus
Exit Sub
End If
If ComboBox6.Value = "" Then
MsgBox "Article number is not registered!", 48, "www.excel.npage.de "
ComboBox6.SetFocus
Exit Sub
End If
If TextBox7.Value = "" Then
MsgBox "Amount is not registered!", 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("" & "Do you really want to delete an entry?" _
& "", vbYesNo, "www.excel.npage.de Delete entry")
If AAAA = vbNo Then
Exit Sub
Else
End If
strSuchen = Application.InputBox _
("Password:", "www.excel.npage.de Delete entry ")
If strSuchen <> 3 Then
MS = MsgBox("The password is wrong!", , "www.excel.npage.de Delete entry")
Exit Sub
Else
End If
strSuchen = Application.InputBox _
("Please enter the desired ID number on", "www.excel.npage.de Delete entry ")
If strSuchen = False Then
AAAA = MsgBox("This ID no. is not present!", , "www.excel.npage.de Delete entry")
Exit Sub
End If
If strSuchen = 0 Then
AAAA = MsgBox("This ID No. (0) does not exist!", , "www.excel.npage.de Delete entry")
Exit Sub
End If
If strSuchen = "" Then
AAAA = MsgBox("Please enter ID no. on!", , "www.excel.npage.de Delete entry")
Exit Sub
End If
If strSuchen = False Then
Exit Sub
Else
ActiveSheet.Range("a11:a65530").Cells.Find(What:=strSuchen, LookAt:=xlWhole).Activate
strFrage = MsgBox("Should this entry be: " & _
"Art.-No-" & ActiveCell.Value & "; " & _
"Date-" & ActiveCell.Offset(0, 1) & "; " & _
"Document-" & ActiveCell.Offset(0, 2) & "; " & _
"really be deleted?", _
vbYesNo, "www.excel.npage.de Delete entry")
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("This ID no. is not present!!", , "www.excel.npage.de Delete entry")
End If
End If
LLLRRR1.Activate
Exit Sub
EERR:
LLLRRR1.Activate
AAAA = MsgBox("This ID no. is not present!!", , "www.excel.npage.de Delete entry")
End Sub
Private Sub AALL_Click()
On Error GoTo EERR
Unload Me
Dim AAAA As Variant
AAAA = MsgBox("" & "Do you really want to delete all booking records?" & " " & "", vbYesNo, "www.excel.npage.de Delete all")
If AAAA = vbNo Then
Exit Sub
Else
End If
strSuchen = Application.InputBox("Password:", "www.excel.npage.de Delete all ")
If strSuchen <> 3 Then
AAAA = MsgBox("The password is wrong!", , "www.excel.npage.de Delete all")
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 "Everything is deleted!", 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 "Error in step 3!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLRRR3.Name
If SCHRI = "" Then
MsgBox "Error in step 4!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLRRR4.Name
If SCHRI <> "Removal certificate" Then
MsgBox "Error in step 5!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLRRR5.Name
If SCHRI = "" Then
MsgBox "Error in step 6!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLRRR6.Name
If SCHRI = "" Then
MsgBox "Error in step 7!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label1.Left
If TSCH = 0 Then
MsgBox "Error in step 8!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label2.Left
If TSCH = 0 Then
MsgBox "Error in step 9!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label3.Left
If TSCH = 0 Then
MsgBox "Error in step 10!", , "www.excel.npage.de"
End If
For ††† = 4 To 5
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Error in step 11!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = ComboBox1.Left
If TSCH = 0 Then
MsgBox "Error in step 12!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton1.Left
If TSCH = 0 Then
MsgBox "Error in step 13!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = EELL.Left
If TSCH = 0 Then
MsgBox "Error in step 14!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = AALL.Left
If TSCH = 0 Then
MsgBox "Error in step 14!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = BLFN.Left
If TSCH = 0 Then
MsgBox "Error in step 14!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CheckBox1.Left
If TSCH = 0 Then
MsgBox "Error in step 15!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ENTS.Left
If TSCH = 0 Then
MsgBox "Error in step 16!", , "www.excel.npage.de"
End If
For ††† = 1 To 3
TSCH = 1
TSCH = Me.Controls("Frame" & CStr(†††)).Left
If TSCH = 1 Then
MsgBox "Error in step 17-18!", , "www.excel.npage.de"
End If
Next †††
TSCH = 11
TSCH = ListBox1.Left
If TSCH = 11 Then
MsgBox "Error in step 19!", , "www.excel.npage.de"
End If
For ††† = 6 To 12
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 31!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = ENTSN.Left
If TSCH = 0 Then
MsgBox "Error in step 31!", , "www.excel.npage.de"
End If
For ††† = 4 To 5
TSCH = 0
TSCH = Me.Controls("ComboBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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#######################