Create stock program with pictures in Excel VBA itself
List of manufacturing steps and code
0_Create stock program with pictures in Excel VBA itself_How it works
1_Create stock program with pictures in Excel VBA itself_Workbook
2_Create stock program with pictures in Excel VBA itself_Create Input mask
3_Create stock program with pictures in Excel VBA itself_Sheet Article
4_Create stock program with pictures in Excel VBA itself_Sheet Journal
5_Create stock program with pictures in Excel VBA itself_Sheet Removal certificate
6_Create stock program with pictures in Excel VBA itself_Sheet Accounts
7_Create stock program with pictures in Excel VBA itself_Sheet List
8_Create stock program with pictures in Excel VBA itself_Image1
9_Create stock program with pictures in Excel VBA itself_Label1
10_Create stock program with pictures in Excel VBA itself_Label2- Label4
11_Create stock program with pictures in Excel VBA itself_Frame1
12_Create stock program with pictures in Excel VBA itself_Image2
13_Create stock program with pictures in Excel VBA itself_Label5
14_Create stock program with pictures in Excel VBA itself_Label6- Label8
15_Create stock program with pictures in Excel VBA itself_Label9
16_Create stock program with pictures in Excel VBA itself_Label10- Label11
17_Create stock program with pictures in Excel VBA itself_ComboBox1
18_Create stock program with pictures in Excel VBA itself_CommandButton1
19_Create stock program with pictures in Excel VBA itself_19_CommandButton2
20_Create stock program with pictures in Excel VBA itself_Activation order in Frame1
21_Create stock program with pictures in Excel VBA itself_Frame2
22_Create stock program with pictures in Excel VBA itself_Label12
23_Create stock program with pictures in Excel VBA itself_Label13- Label19
24_Create stock program with pictures in Excel VBA itself_ComboBox2
25_Create stock program with pictures in Excel VBA itself_ComboBox3
26_Create stock program with pictures in Excel VBA itself_TextBox1
27_Create stock program with pictures in Excel VBA itself_TextBox2-TextBox3
28_Create stock program with pictures in Excel VBA itself_Label20
29_Create stock program with pictures in Excel VBA itself_Label21- Label22
30_Create stock program with pictures in Excel VBA itself_CommandButton3
31_Create stock program with pictures in Excel VBA itself_CommandButton4
32_Create stock program with pictures in Excel VBA itself_Activation order in Frame2
33_Create stock program with pictures in Excel VBA itself_Frame3
34_Create stock program with pictures in Excel VBA itself_Activation order in Frame3
35_Create stock program with pictures in Excel VBA itself_CommandButton7
36_Create stock program with pictures in Excel VBA itself_CommandButton8
37_Create stock program with pictures in Excel VBA itself_ListBox1
38_Create stock program with pictures in Excel VBA itself_Sheet LLLNNN7
39_Create stock program with pictures in Excel VBA itself_Enter code in Userform1
'''1_1_ LB##########
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_ LB##########
'''2_1_ LB##########
=SUM(D3:D758)
'''2_1_ LB##########
'''2_2_ LB##########
=SUM(E3:E758)
'''2_2_ LB##########
'''3_3_ LB##########
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_ LB##########
'''4_1_ LB#############
Sub CAZUUFAF()
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 <> "Zailer" 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 <> "Zailer" And ActiveSheet.Name <> "POMO" Then
TANA = ActiveSheet.Name
End If
Exit Sub
ERR:
End Sub
Private Sub ComboBox1_Change()
On Error GoTo EERR
Dim DDAATT As String
DDAATT = ""
Image1.Picture = LoadPicture(DDAATT)
Image2.Picture = LoadPicture(DDAATT)
Label1.Caption = ""
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
Label9.Caption = ""
Label10.Caption = ""
Label11.Caption = ""
Dim AAAC As Long
Dim strSuchen As Variant
If ComboBox1.Value <> "" Then
ComboBox3.Value = ""
ComboBox5.Value = ""
strSuchen = ComboBox1.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
Label9.Caption = LLLNNN2.Cells(AAAC, 2)
Label10.Caption = LLLNNN2.Cells(AAAC, 3)
Label11.Caption = Round(LLLNNN2.Cells(AAAC, 6), 2)
Label1.Caption = LLLNNN2.Cells(AAAC, 2)
Label2.Caption = "Bestand: " & LLLNNN2.Cells(AAAC, 4) & " " & LLLNNN2.Cells(AAAC, 3)
Label3.Caption = "Gesamtwert: " & Round(LLLNNN2.Cells(AAAC, 5), 2)
Label4.Caption = "Preis " & "/" & LLLNNN2.Cells(AAAC, 3) & " " & Round(LLLNNN2.Cells(AAAC, 6), 2)
End If
Exit Sub
EERR:
ComboBox1.Value = ""
End Sub
Private Sub ComboBox1_Click()
On Error GoTo EERR
Dim DDAATT As String
Dim AAAR As Long
Dim AAAC As Long
Dim strSuchen As Variant
If ComboBox1.Value <> "" Then
strSuchen = ComboBox1.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
AAAR = 2 + (AAAC - 3) * 5
If LLLNNN5.Cells(7, AAAR).Value <> "" Then
DDAATT = LLLNNN5.Cells(7, AAAR).Value
Image1.Picture = LoadPicture(DDAATT)
Image2.Picture = LoadPicture(DDAATT)
End If
End If
Exit Sub
EERR:
LLLNNN5.Cells(7, AAAR).Value = ""
End Sub
Private Sub ComboBox2_Change()
On Error GoTo EERR
Label18.Visible = True
TextBox2.Visible = True
If ComboBox2.Value = "Procurement costs" Or ComboBox2.Value = "Credit/Discounts" Then
Label18.Visible = False
TextBox2.Visible = False
TextBox2.Value = ""
End If
If ComboBox2.Value = "Procurement costs" Or ComboBox2.Value = "Credit/Discounts" Or ComboBox2.Value = "Access" Then
ComboBox4.Value = ""
Exit Sub
Else:
ComboBox2.Value = ""
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox3_Change()
On Error GoTo EERR
Dim DDAATT As String
DDAATT = ""
Image1.Picture = LoadPicture(DDAATT)
Image2.Picture = LoadPicture(DDAATT)
Label1.Caption = ""
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
Label20.Caption = ""
Label21.Caption = ""
Label22.Caption = ""
Call Z2ZZZLB
Exit Sub
EERR:
ComboBox3.Value = ""
End Sub
Private Sub ComboBox3_Click()
On Error GoTo EERR
Dim DDAATT As String
Dim AAAR As Long
Dim AAAC As Long
Dim strSuchen As Variant
If ComboBox3.Value <> "" Then
strSuchen = ComboBox3.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
AAAR = 2 + (AAAC - 3) * 5
If LLLNNN5.Cells(7, AAAR).Value <> "" Then
DDAATT = LLLNNN5.Cells(7, AAAR).Value
Image1.Picture = LoadPicture(DDAATT)
Image2.Picture = LoadPicture(DDAATT)
End If
End If
Exit Sub
EERR:
LLLNNN5.Cells(7, AAAR).Value = ""
End Sub
Private Sub ComboBox4_Change()
On Error GoTo EERR
ListBox1.BoundColumn = 8
ListBox1.ColumnCount = 8
ComboBox6.Value = ""
With LLLNNN3
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
Dim AAAZ As Long
Dim AAAZ2 As Long
Dim strSuchen As Variant
If ComboBox4.Value <> "" Then
ComboBox2.Value = ""
strSuchen = ComboBox4.Value
AAAZ = CDbl(LLLNNN6.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
LLLNNN4.[e13] = CDbl(ComboBox4.Value)
LLLNNN4.Range("a16:i55") = ""
ComboBox6.Clear
Dim SCHOT As Long
Dim AAAC As Long
Dim SCHOT2
For SCHOT = 0 To 39
AAAC = 2 + SCHOT * 9
If LLLNNN6.Cells(AAAZ, AAAC).Value <> "" Then
AAAZ2 = CDbl(LLLNNN4.Cells(Rows.Count, 1).End(xlUp).Row) + 1
For SCHOT2 = 1 To 9
LLLNNN4.Cells(AAAZ2, SCHOT2).Value = LLLNNN6.Cells(AAAZ, AAAC + SCHOT2 - 1).Value
Next SCHOT2
With ComboBox6
.AddItem LLLNNN6.Cells(AAAZ, AAAC).Value
End With
End If
Next SCHOT
ListBox1.BoundColumn = 9
ListBox1.ColumnCount = 9
With LLLNNN4
ListBox1.RowSource = .Range(.Cells(16, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 9)).Address(External:=True)
ListBox1.ListIndex = ListBox1.ListCount - 1
End With
End If
Exit Sub
EERR:
ComboBox4.Value = ""
End Sub
Private Sub ComboBox4_DropButtonClick()
On Error GoTo EERR
LLLNNN6.[a2] = 1
Dim AAAZ As Long
AAAZ = CDbl(LLLNNN6.Cells(Rows.Count, 1).End(xlUp).Row)
If LLLNNN6.Cells(AAAZ, 2) <> "" Then
LLLNNN6.Cells(AAAZ + 1, 1) = LLLNNN6.Cells(AAAZ, 1) + 1
End If
With LLLNNN6
ComboBox4.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
Exit Sub
EERR:
End Sub
Private Sub ComboBox5_Change()
On Error GoTo EERR
Dim DDAATT As String
DDAATT = ""
Image1.Picture = LoadPicture(DDAATT)
Image2.Picture = LoadPicture(DDAATT)
Label1.Caption = ""
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
Label31.Caption = ""
Label32.Caption = ""
Label33.Caption = ""
TextBox5.Value = ""
Label34.Caption = ""
Dim AAAC As Long
Dim strSuchen As Variant
If ComboBox5.Value <> "" Then
ComboBox1.Value = ""
ComboBox3.Value = ""
strSuchen = ComboBox5.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
Label31.Caption = LLLNNN2.Cells(AAAC, 2)
Label32.Caption = LLLNNN2.Cells(AAAC, 3)
Label33.Caption = Round(LLLNNN2.Cells(AAAC, 6), 2)
Label1.Caption = LLLNNN2.Cells(AAAC, 2)
Label2.Caption = "Bestand: " & LLLNNN2.Cells(AAAC, 4) & " " & LLLNNN2.Cells(AAAC, 3)
Label3.Caption = "Gesamtwert: " & Round(LLLNNN2.Cells(AAAC, 5), 2)
Label4.Caption = "Preis " & "/" & LLLNNN2.Cells(AAAC, 3) & " " & Round(LLLNNN2.Cells(AAAC, 6), 2)
End If
Exit Sub
EERR:
ComboBox5.Value = ""
End Sub
Private Sub ComboBox5_Click()
On Error GoTo EERR
Dim DDAATT As String
Dim AAAR As Long
Dim AAAC As Long
Dim strSuchen As Variant
If ComboBox5.Value <> "" Then
strSuchen = ComboBox5.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
AAAR = 2 + (AAAC - 3) * 5
If LLLNNN5.Cells(7, AAAR).Value <> "" Then
DDAATT = LLLNNN5.Cells(7, AAAR).Value
Image1.Picture = LoadPicture(DDAATT)
Image2.Picture = LoadPicture(DDAATT)
End If
End If
Exit Sub
EERR:
LLLNNN5.Cells(7, AAAR).Value = ""
End Sub
Private Sub ComboBox6_Change()
On Error GoTo EERR
ComboBox5.Value = ""
Label31.Caption = ""
Label32.Caption = ""
Label33.Caption = ""
TextBox5.Value = ""
Label34.Caption = ""
If ComboBox4.Value = "" Then
ComboBox6.Value = ""
End If
If ComboBox6.Value <> "" Then
If CDbl(ComboBox6.Value) < 1 Or CDbl(ComboBox6.Value) > 40 Then
MsgBox "Number of position should not be less than 1 and not greater than 40!", 48, "www.excel.npage.de "
ComboBox6.Value = ""
End If
ComboBox6.Value = Round(CDbl(ComboBox6.Value) * 1, 0)
Dim AAAZ As Long
Dim ZAAA As Long
Dim AAAC As Long
Dim strSuchen As Variant
strSuchen = CDbl(ComboBox4.Value)
AAAZ = CDbl(LLLNNN6.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
ZAAA = CDbl(ComboBox6.Value)
AAAC = 2 + (ZAAA - 1) * 9
ComboBox5.Value = LLLNNN6.Cells(AAAZ, AAAC + 2).Value
Label31.Caption = LLLNNN6.Cells(AAAZ, AAAC + 3).Value
Label32.Caption = LLLNNN6.Cells(AAAZ, AAAC + 4).Value
Label33.Caption = LLLNNN6.Cells(AAAZ, AAAC + 5).Value
End If
Exit Sub
EERR:
ComboBox6.Value = ""
End Sub
Private Sub CommandButton1_Click()
On Error GoTo EERR
If ComboBox1.Value = "" Then
MsgBox "Article number is not selected!", 48, "www.excel.npage.de "
ComboBox1.SetFocus
Exit Sub
End If
Dim ††† As String
Dim AAAR As Long
Dim AAAC As Long
Dim strSuchen As Variant
††† = Application.GetOpenFilename(, , "Bild auswählen www.excel.npage.de", , False)
Select Case Right(†††, 3)
Case "ani", "apng", "bmp", "cht", "cur", "gif", "ico", "jpg", "jpeg", "kml", "png", "rgb", "svg", "svgz", "tif", "tiff", "xbm", "xpm", "JPG", "ANI", "APNG", "BMP", "CHT", "CUR", "GIF", "ICO", "JPEG", "KML", "PNG", "RGB", "SVG", "SVGZ", "TIF", "TIFF", "XBM", "XPM"
Case Else
MsgBox "You have chosen no valid image!", 48, "www.excel.npage.de "
End Select
Image1.Picture = LoadPicture(†††)
Image2.Picture = LoadPicture(†††)
If ComboBox1.Value <> "" Then
strSuchen = ComboBox1.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
AAAR = 2 + (AAAC - 3) * 5
LLLNNN5.Cells(7, AAAR).Value = †††
End If
Exit Sub
EERR:
End Sub
Private Sub CommandButton2_Click()
On Error GoTo EERR
If ComboBox1.Value = "" Then
MsgBox "Article number is not selected!", 48, "www.excel.npage.de "
ComboBox1.SetFocus
Exit Sub
End If
Unload Me
Dim DDNN As Variant
DDNN = Application.InputBox("Password:", "www.excel.npage.de Remove image")
If DDNN <> 3 Then
MsgBox "The password is incorrect!", , "www.excel.npage.de Remove image"
Exit Sub
Else
End If
Dim AAAR As Long
Dim AAAC As Long
Dim strSuchen As Variant
If ComboBox1.Value <> "" Then
strSuchen = ComboBox1.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
AAAR = 2 + (AAAC - 3) * 5
LLLNNN5.Cells(7, AAAR).Value = ""
End If
MsgBox "The article has no image!", 48, "www.excel.npage.de "
Exit Sub
EERR:
End Sub
Private Sub CommandButton3_Click()
On Error GoTo EERR
If ComboBox2 = "Access" Then
TextBox2.SetFocus
End If
TextBox3.SetFocus
ComboBox2.SetFocus
If LLLNNN3.[a100000] <> "" 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 input!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If ComboBox2.Value = "" Then
MsgBox "Business case is not selected!", 48, "www.excel.npage.de "
ComboBox2.SetFocus
Exit Sub
End If
If ComboBox3.Value = "" Then
MsgBox "Article number is not registered!", 48, "www.excel.npage.de "
ComboBox3.SetFocus
Exit Sub
End If
Dim ††† As Long
Dim AAAR As Long
Dim †††2 As Long
Dim strSuchen As Variant
LLLNNN3.[a11] = 0
††† = CDbl(LLLNNN3.Cells(Rows.Count, 1).End(xlUp).Row) + 1
LLLNNN3.Cells(†††, 1) = LLLNNN3.Cells(††† - 1, 1) + 1
LLLNNN3.Cells(†††, 1).HorizontalAlignment = xlCenter
LLLNNN3.Cells(†††, 2) = Date
LLLNNN3.Cells(†††, 2) = Format(Date, "dd.mm.yyyy")
LLLNNN3.Cells(†††, 2).HorizontalAlignment = xlCenter
LLLNNN3.Cells(†††, 3) = TextBox1.Value
LLLNNN3.Cells(†††, 3).HorizontalAlignment = xlCenter
LLLNNN3.Cells(†††, 4) = ComboBox3.Value
LLLNNN3.Cells(†††, 4).HorizontalAlignment = xlCenter
LLLNNN3.Cells(†††, 5) = Label20.Caption
LLLNNN3.Cells(†††, 5).HorizontalAlignment = xlCenter
LLLNNN3.Cells(†††, 6) = Label21.Caption
LLLNNN3.Cells(†††, 6).HorizontalAlignment = xlCenter
If ComboBox2 = "Access" Then
LLLNNN3.Cells(†††, 7) = CDbl(TextBox2.Value)
LLLNNN3.Cells(†††, 7).HorizontalAlignment = xlCenter
End If
If ComboBox2 = "Access" Or ComboBox2 = "Procurement costs" Then
LLLNNN3.Cells(†††, 8) = Round(CDbl(TextBox3.Value), 2)
Else:
LLLNNN3.Cells(†††, 8) = Round(CDbl(TextBox3.Value), 2) * -1
End If
LLLNNN3.Cells(†††, 8).HorizontalAlignment = xlCenter
strSuchen = ComboBox3.Value
†††2 = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
AAAR = 2 + (†††2 - 3) * 5
LLLNNN5.Cells(†††, AAAR) = LLLNNN3.Cells(†††, 1)
LLLNNN5.Cells(†††, AAAR).HorizontalAlignment = xlCenter
LLLNNN5.Cells(†††, AAAR + 1) = LLLNNN3.Cells(†††, 2)
LLLNNN5.Cells(†††, AAAR + 1) = Format(Date, "dd.mm.yyyy")
LLLNNN5.Cells(†††, AAAR + 1).HorizontalAlignment = xlCenter
LLLNNN5.Cells(†††, AAAR + 2) = LLLNNN3.Cells(†††, 3)
LLLNNN5.Cells(†††, AAAR + 2).HorizontalAlignment = xlCenter
LLLNNN5.Cells(†††, AAAR + 3) = LLLNNN3.Cells(†††, 7)
LLLNNN5.Cells(†††, AAAR + 3).HorizontalAlignment = xlCenter
LLLNNN5.Cells(†††, AAAR + 4) = LLLNNN3.Cells(†††, 8)
LLLNNN5.Cells(†††, AAAR + 4).HorizontalAlignment = xlCenter
LLLNNN5.Cells(4, AAAR + 3).FormulaR1C1 = "=SUM(R[8]C:R[65526]C)"
LLLNNN5.Cells(5, AAAR + 4).FormulaR1C1 = "=SUM(R[7]C:R[65525]C)"
LLLNNN5.Cells(4, AAAR + 3) = LLLNNN5.Cells(4, AAAR + 3).Value
LLLNNN5.Cells(5, AAAR + 4) = LLLNNN5.Cells(5, AAAR + 4).Value
If LLLNNN5.Cells(4, AAAR + 3) > 0 Then
LLLNNN5.Cells(6, AAAR) = Round(LLLNNN5.Cells(5, AAAR + 4) / LLLNNN5.Cells(4, AAAR + 3), 2)
Else:
LLLNNN5.Cells(6, AAAR) = 0
End If
Call Z3ZZZLB
With LLLNNN3
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
Call Z2ZZZLB
TextBox2.Value = ""
TextBox3.Value = ""
Exit Sub
EERR:
End Sub
Private Sub CommandButton4_Click()
On Error GoTo EERR
If ComboBox3.Value = "" Then
MsgBox "Article number is not selected!", 48, "www.excel.npage.de "
ComboBox3.SetFocus
Exit Sub
End If
Dim strSuchen As Variant
Dim SCHOT As Long
Dim AAAC As Long
Dim AAAC2 As Long
Dim AAAZ As Long
If ComboBox3 <> "" Then
LLLNNN7.Range("a1:f65530") = ""
strSuchen = ComboBox3.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
AAAC2 = 2 + (AAAC - 3) * 5
For SCHOT = 1 To 6
LLLNNN7.Cells(SCHOT + 1, 1) = LLLNNN2.Cells(2, SCHOT)
Next SCHOT
LLLNNN7.Cells(2, 4) = LLLNNN2.Cells(AAAC, 1)
LLLNNN7.Cells(3, 4) = LLLNNN2.Cells(AAAC, 2)
LLLNNN7.Cells(4, 4) = LLLNNN2.Cells(AAAC, 3)
LLLNNN7.Cells(5, 4) = LLLNNN5.Cells(4, AAAC2 + 3)
LLLNNN7.Cells(6, 5) = LLLNNN5.Cells(5, AAAC2 + 4)
LLLNNN7.Cells(7, 4) = LLLNNN5.Cells(6, AAAC2)
For SCHOT = 1 To 5
LLLNNN7.Cells(9, SCHOT) = LLLNNN5.Cells(11, SCHOT - 1 + AAAC2)
Next SCHOT
For SCHOT = 1 To 100000
If LLLNNN5.Cells(SCHOT - 1 + 12, AAAC2) <> "" Then
AAAZ = CDbl(LLLNNN7.Cells(Rows.Count, 1).End(xlUp).Row) + 1
LLLNNN7.Cells(AAAZ, 1) = LLLNNN5.Cells(SCHOT - 1 + 12, AAAC2)
LLLNNN7.Cells(AAAZ, 2) = LLLNNN5.Cells(SCHOT - 1 + 12, AAAC2 + 1)
LLLNNN7.Cells(AAAZ, 3) = LLLNNN5.Cells(SCHOT - 1 + 12, AAAC2 + 2)
LLLNNN7.Cells(AAAZ, 4) = LLLNNN5.Cells(SCHOT - 1 + 12, AAAC2 + 3)
LLLNNN7.Cells(AAAZ, 5) = LLLNNN5.Cells(SCHOT - 1 + 12, AAAC2 + 4)
End If
Next SCHOT
LLLNNN7.Name = "Nr_" & LLLNNN7.[d2]
LLLNNN7.Activate
Dim DDAATT As String
Dim ZZEELL As Range
Dim SCAAL As Double
LLLNNN7.[d1].Select
ActiveSheet.Columns("d:d").ColumnWidth = 22.14
ActiveSheet.Rows("1:1").RowHeight = 62.25
Dim SEGG
For Each SEGG In ActiveSheet.Shapes
If Not Intersect(SEGG.TopLeftCell, ActiveCell) Is Nothing Then SEGG.Delete
Next SEGG
Set ZZEELL = ActiveCell
DDAATT = LLLNNN5.Cells(7, AAAC2)
Select Case Right(DDAATT, 3)
Case "ani", "apng", "bmp", "cht", "cur", "gif", "ico", "jpg", "jpeg", "kml", "png", "rgb", "svg", "svgz", "tif", "tiff", "xbm", "xpm", "JPG", "ANI", "APNG", "BMP", "CHT", "CUR", "GIF", "ICO", "JPEG", "KML", "PNG", "RGB", "SVG", "SVGZ", "TIF", "TIFF", "XBM", "XPM"
ActiveSheet.Pictures.Insert(DDAATT).Select
With Selection.ShapeRange
.Top = ZZEELL.Top
.Left = ZZEELL.Left
SCAAL = WorksheetFunction.Min(ZZEELL.Width / .Width, ZZEELL.Height / .Height)
.Height = .Height * SCAAL
End With
Selection.Placement = xlMoveAndSize
Selection.PrintObject = True
Case Else
MsgBox "Selected article has no image!", 48, "www.excel.npage.de "
End Select
LLLNNN7.[d2].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, 5).EntireColumn.AutoFit
With ActiveSheet.PageSetup
.RightHeader = ActiveSheet.Name & ": &P/&N"
End With
LLLNNN7.Activate
UserForm1.Hide
End If
Exit Sub
EERR:
End Sub
Private Sub CommandButton5_Click()
On Error GoTo EERR
If LLLNNN3.[a10000] <> "" Then
MsgBox "The Journal is full!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If ComboBox4 = "" Then
MsgBox "Removal certificate No. is not selected!", 48, "www.excel.npage.de "
ComboBox4.SetFocus
Exit Sub
End If
If ComboBox6 = "" Then
MsgBox "Position is not selected!", 48, "www.excel.npage.de "
ComboBox6.SetFocus
Exit Sub
End If
If ComboBox5 = "" Then
MsgBox "Article No. is not selected!", 48, "www.excel.npage.de "
ComboBox5.SetFocus
Exit Sub
End If
If TextBox5 = "" Then
MsgBox "Quantity is not selected!", 48, "www.excel.npage.de "
TextBox5.SetFocus
Exit Sub
End If
Dim AAAZ As Long
Dim AAAC As Long
Dim ZAAA As Long
Dim strSuchen As Variant
strSuchen = ComboBox4.Value
AAAZ = CDbl(LLLNNN6.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
ZAAA = CDbl(ComboBox6.Value)
AAAC = 2 + (ZAAA - 1) * 9
LLLNNN6.Cells(AAAZ, AAAC) = CDbl(ComboBox6.Value)
LLLNNN6.Cells(AAAZ, AAAC + 1) = Date
LLLNNN6.Cells(AAAZ, AAAC + 2) = ComboBox5.Value
LLLNNN6.Cells(AAAZ, AAAC + 3) = Label31.Caption
LLLNNN6.Cells(AAAZ, AAAC + 4) = Label32.Caption
LLLNNN6.Cells(AAAZ, AAAC + 5) = CDbl(Label33.Caption)
LLLNNN6.Cells(AAAZ, AAAC + 6) = CDbl(TextBox5.Value)
LLLNNN6.Cells(AAAZ, AAAC + 7) = CDbl(Label34.Caption)
Dim AAAZ2 As Long
Dim AAAZ3 As Long
Dim AAAR As Long
If LLLNNN6.Cells(AAAZ, AAAC + 8) <> "" Then
AAAZ2 = LLLNNN6.Cells(AAAZ, AAAC + 8) + 11
AAAZ3 = CDbl(LLLNNN2.Range("a3:a758").Find(What:=LLLNNN3.Cells(AAAZ2, 4), lookat:=xlWhole).Row)
AAAR = 2 + (AAAZ3 - 3) * 5
LLLNNN5.Cells(AAAZ2, AAAR) = ""
LLLNNN5.Cells(AAAZ2, AAAR + 1) = ""
LLLNNN5.Cells(AAAZ2, AAAR + 2) = ""
LLLNNN5.Cells(AAAZ2, AAAR + 3) = ""
LLLNNN5.Cells(AAAZ2, AAAR + 4) = ""
LLLNNN5.Cells(4, AAAR + 3).FormulaR1C1 = "=SUM(R[8]C:R[65526]C)"
LLLNNN5.Cells(5, AAAR + 4).FormulaR1C1 = "=SUM(R[7]C:R[65525]C)"
LLLNNN5.Cells(4, AAAR + 3) = LLLNNN5.Cells(4, AAAR + 3).Value
LLLNNN5.Cells(5, AAAR + 4) = LLLNNN5.Cells(5, AAAR + 4).Value
If LLLNNN5.Cells(4, AAAR + 3) > 0 Then
LLLNNN5.Cells(6, AAAR) = Round(LLLNNN5.Cells(5, AAAR + 4) / LLLNNN5.Cells(4, AAAR + 3), 2)
Else:
LLLNNN5.Cells(6, AAAR) = 0
End If
LLLNNN3.Cells(AAAZ2, 1) = ""
LLLNNN3.Cells(AAAZ2, 2) = ""
LLLNNN3.Cells(AAAZ2, 3) = ""
LLLNNN3.Cells(AAAZ2, 4) = ""
LLLNNN3.Cells(AAAZ2, 5) = ""
LLLNNN3.Cells(AAAZ2, 6) = ""
LLLNNN3.Cells(AAAZ2, 7) = ""
LLLNNN3.Cells(AAAZ2, 8) = ""
LLLNNN5.Cells(AAAZ2, 3782) = ""
LLLNNN5.Cells(AAAZ2, 3783) = ""
LLLNNN6.Cells(AAAZ, AAAC + 8) = ""
End If
If LLLNNN6.Cells(AAAZ, AAAC + 8) = "" Then
AAAZ2 = CDbl(LLLNNN3.Cells(Rows.Count, 1).End(xlUp).Row) + 1
LLLNNN6.Cells(AAAZ, AAAC + 8) = AAAZ2
LLLNNN3.Cells(AAAZ2, 1) = LLLNNN3.Cells(AAAZ2 - 1, 1) + 1
LLLNNN3.Cells(AAAZ2, 1).HorizontalAlignment = xlCenter
LLLNNN3.Cells(AAAZ2, 2) = LLLNNN6.Cells(AAAZ, AAAC)
LLLNNN3.Cells(AAAZ2, 2) = Format(Date, "dd.mm.yyyy")
LLLNNN3.Cells(AAAZ2, 2).HorizontalAlignment = xlCenter
LLLNNN3.Cells(AAAZ2, 3) = "Ent.Sch." & ComboBox4.Value & "/" & ComboBox6.Value
LLLNNN3.Cells(AAAZ2, 3).HorizontalAlignment = xlCenter
LLLNNN3.Cells(AAAZ2, 4) = LLLNNN6.Cells(AAAZ, AAAC + 2)
LLLNNN3.Cells(AAAZ2, 4).HorizontalAlignment = xlCenter
LLLNNN3.Cells(AAAZ2, 5) = LLLNNN6.Cells(AAAZ, AAAC + 3)
LLLNNN3.Cells(AAAZ2, 5).HorizontalAlignment = xlCenter
LLLNNN3.Cells(AAAZ2, 6) = LLLNNN6.Cells(AAAZ, AAAC + 4)
LLLNNN3.Cells(AAAZ2, 6).HorizontalAlignment = xlCenter
LLLNNN3.Cells(AAAZ2, 7) = LLLNNN6.Cells(AAAZ, AAAC + 6) * -1
LLLNNN3.Cells(AAAZ2, 7).HorizontalAlignment = xlCenter
LLLNNN3.Cells(AAAZ2, 8) = LLLNNN6.Cells(AAAZ, AAAC + 7) * -1
LLLNNN3.Cells(AAAZ2, 8).HorizontalAlignment = xlCenter
AAAZ3 = CDbl(LLLNNN2.Range("a3:a758").Find(What:=ComboBox5.Value, lookat:=xlWhole).Row)
AAAR = 2 + (AAAZ3 - 3) * 5
LLLNNN5.Cells(AAAZ2, AAAR) = LLLNNN3.Cells(AAAZ2, 1)
LLLNNN5.Cells(AAAZ2, AAAR).HorizontalAlignment = xlCenter
LLLNNN5.Cells(AAAZ2, AAAR + 1) = LLLNNN3.Cells(AAAZ2, 2)
LLLNNN5.Cells(AAAZ2, AAAR + 1) = Format(Date, "dd.mm.yyyy")
LLLNNN5.Cells(AAAZ2, AAAR + 1).HorizontalAlignment = xlCenter
LLLNNN5.Cells(AAAZ2, AAAR + 2) = LLLNNN3.Cells(AAAZ2, 3)
LLLNNN5.Cells(AAAZ2, AAAR + 2).HorizontalAlignment = xlCenter
LLLNNN5.Cells(AAAZ2, AAAR + 3) = LLLNNN3.Cells(AAAZ2, 7)
LLLNNN5.Cells(AAAZ2, AAAR + 3).HorizontalAlignment = xlCenter
LLLNNN5.Cells(AAAZ2, AAAR + 4) = LLLNNN3.Cells(AAAZ2, 8)
LLLNNN5.Cells(AAAZ2, AAAR + 4).HorizontalAlignment = xlCenter
LLLNNN5.Cells(4, AAAR + 3).FormulaR1C1 = "=SUM(R[8]C:R[65526]C)"
LLLNNN5.Cells(5, AAAR + 4).FormulaR1C1 = "=SUM(R[7]C:R[65525]C)"
LLLNNN5.Cells(4, AAAR + 3) = LLLNNN5.Cells(4, AAAR + 3).Value
LLLNNN5.Cells(5, AAAR + 4) = LLLNNN5.Cells(5, AAAR + 4).Value
If LLLNNN5.Cells(4, AAAR + 3) > 0 Then
LLLNNN5.Cells(6, AAAR) = Round(LLLNNN5.Cells(5, AAAR + 4) / LLLNNN5.Cells(4, AAAR + 3), 2)
Else:
LLLNNN5.Cells(6, AAAR) = 0
End If
LLLNNN5.Cells(AAAZ2, 3782) = CDbl(ComboBox4.Value)
LLLNNN5.Cells(AAAZ2, 3783) = CDbl(ComboBox6.Value)
LLLNNN6.Cells(AAAZ, AAAC + 8) = LLLNNN3.Cells(AAAZ2, 1)
End If
Call Z3ZZZLB
Label24.Caption = ComboBox6.Value
Label25.Caption = ComboBox5.Value
Call ComboBox4_Change
ComboBox6.Value = "_"
ComboBox6.Value = Label24.Caption
Label24.Caption = "Position"
ComboBox5.Value = Label25.Caption
Label25.Caption = "Artikel-Nr."
TextBox5.Value = ""
ComboBox6.SetFocus
Exit Sub
EERR:
End Sub
Private Sub CommandButton6_Click()
On Error GoTo EERR
If ComboBox4.Value <> "" Then
LLLNNN4.Activate
LLLNNN4.[e13].Select
Dim SHOT As Long
For SHOT = 1 To 8
ActiveSheet.Cells(Rows.Count, SHOT).EntireColumn.AutoFit
Next SHOT
With ActiveSheet.PageSetup
.RightHeader = ActiveSheet.Name & ActiveSheet.[e13] & ": &P/&N"
End With
LLLNNN4.Activate
UserForm1.Hide
End If
Exit Sub
EERR:
End Sub
Private Sub CommandButton7_Click()
On Error GoTo EERR
LLLNNN3.Activate
Unload Me
Dim AAAA As Variant
Dim strSuchen As Variant
Dim strFrage As Double
AAAA = MsgBox("" & "Do you really want delete an entry?" & "", vbYesNo, "www.excel.npage.de Delete")
If AAAA = vbNo Then
Exit Sub
Else
End If
strSuchen = Application.InputBox("Password:", "www.excel.npage.de Delete ")
If strSuchen <> 3 Then
AAAA = MsgBox("The password is incorrect", , "www.excel.npage.de Delete")
Exit Sub
Else
End If
strSuchen = Application.InputBox("Please enter desired ID number. on", "www.excel.npage.de Delete ")
If strSuchen = False Then
AAAA = MsgBox("This ID number is not present", , "www.excel.npage.de Delete")
Exit Sub
End If
If strSuchen = 0 Then
AAAA = MsgBox("This ID number (0) is not present", , "www.excel.npage.de Delete")
Exit Sub
End If
If strSuchen = "" Then
AAAA = MsgBox("Enter ID number please ", , "www.excel.npage.de Delete")
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: " & "ID-No.-" & ActiveCell.Value & "; " & "Date-" & ActiveCell.Offset(0, 1) & "; " & "Document-" & ActiveCell.Offset(0, 2) & "; " & "really be deleted?", vbYesNo, "www.excel.npage.de Delete")
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(LLLNNN2.Range("a3:a758").Find(What:=LLLNNN3.Cells(AAAZ, 4), lookat:=xlWhole).Row)
AAAR = 2 + (AAAZ2 - 3) * 5
Dim SHHOT As Long
For SHHOT = 1 To 8
ActiveSheet.Cells(AAAZ, SHHOT) = ""
Next SHHOT
LLLNNN5.Cells(AAAZ, AAAR) = ""
LLLNNN5.Cells(AAAZ, AAAR + 1) = ""
LLLNNN5.Cells(AAAZ, AAAR + 2) = ""
LLLNNN5.Cells(AAAZ, AAAR + 3) = ""
LLLNNN5.Cells(AAAZ, AAAR + 4) = ""
LLLNNN5.Cells(4, AAAR + 3).FormulaR1C1 = "=SUM(R[8]C:R[65526]C)"
LLLNNN5.Cells(5, AAAR + 4).FormulaR1C1 = "=SUM(R[7]C:R[65525]C)"
LLLNNN5.Cells(4, AAAR + 3) = LLLNNN5.Cells(4, AAAR + 3).Value
LLLNNN5.Cells(5, AAAR + 4) = LLLNNN5.Cells(5, AAAR + 4).Value
If LLLNNN5.Cells(4, AAAR + 3) > 0 Then
LLLNNN5.Cells(6, AAAR) = Round(LLLNNN5.Cells(5, AAAR + 4) / LLLNNN5.Cells(4, AAAR + 3), 2)
Else:
LLLNNN5.Cells(6, AAAR) = 0
End If
If LLLNNN5.Cells(AAAZ, 3782) <> "" Then
Dim AAAC As Long
AAAR = LLLNNN5.Cells(AAAZ, 3782) + 1
SHHOT = LLLNNN5.Cells(AAAZ, 3783)
AAAC = 2 + (SHHOT - 1) * 9
For AAAZ2 = 0 To 8
LLLNNN6.Cells(AAAR, AAAC + AAAZ2) = ""
Next AAAZ2
LLLNNN5.Cells(AAAZ, 3782) = ""
LLLNNN5.Cells(AAAZ, 3783) = ""
End If
AAAA = MsgBox("This ID number is not present!", , "www.excel.npage.de Delete")
Dim SCHOT As Integer
For SCHOT = 3 To 758
If LLLNNN5.Cells(4, 2 + ((SCHOT - 3) * 5) + 3) <> LLLNNN2.Cells(SCHOT, 4) Then
LLLNNN2.Cells(SCHOT, 4) = LLLNNN5.Cells(4, 2 + ((SCHOT - 3) * 5) + 3)
End If
If LLLNNN5.Cells(5, 2 + ((SCHOT - 3) * 5) + 4) <> LLLNNN2.Cells(SCHOT, 5) Then
LLLNNN2.Cells(SCHOT, 5) = LLLNNN5.Cells(5, 2 + ((SCHOT - 3) * 5) + 4)
End If
If LLLNNN5.Cells(6, 2 + ((SCHOT - 3) * 5)) <> LLLNNN2.Cells(SCHOT, 6) Then
LLLNNN2.Cells(SCHOT, 6) = LLLNNN5.Cells(6, 2 + ((SCHOT - 3) * 5))
End If
Next SCHOT
End If
End If
LLLNNN1.Activate
Exit Sub
EERR:
LLLNNN1.Activate
AAAA = MsgBox("This ID number is not present!", , "www.excel.npage.de Delete")
End Sub
Sub COMUUFAF()
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 <> "Zailer" 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 <> "Zailer" And ActiveSheet.Name <> "POMO" Then
TANA = ActiveSheet.Name
End If
Exit Sub
ERR:
End Sub
Private Sub CommandButton8_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 everything")
If AAAA = vbNo Then
Exit Sub
Else
End If
strSuchen = Application.InputBox("Password:", "www.excel.npage.de Delete everything ")
If strSuchen <> 3 Then
AAAA = MsgBox("The password is incorrect", , "www.excel.npage.de Delete everything")
Exit Sub
Else
End If
LLLNNN3.Range("a12:h100000") = ""
LLLNNN5.Range("b12:eom100000") = ""
LLLNNN5.Range("b4:eom6") = ""
LLLNNN6.Range("a2:mw100000") = ""
Dim SCHOT As Integer
For SCHOT = 3 To 758
If LLLNNN5.Cells(4, 2 + ((SCHOT - 3) * 5) + 3) <> LLLNNN2.Cells(SCHOT, 4) Then
LLLNNN2.Cells(SCHOT, 4) = LLLNNN5.Cells(4, 2 + ((SCHOT - 3) * 5) + 3)
End If
If LLLNNN5.Cells(5, 2 + ((SCHOT - 3) * 5) + 4) <> LLLNNN2.Cells(SCHOT, 5) Then
LLLNNN2.Cells(SCHOT, 5) = LLLNNN5.Cells(5, 2 + ((SCHOT - 3) * 5) + 4)
End If
If LLLNNN5.Cells(6, 2 + ((SCHOT - 3) * 5)) <> LLLNNN2.Cells(SCHOT, 6) Then
LLLNNN2.Cells(SCHOT, 6) = LLLNNN5.Cells(6, 2 + ((SCHOT - 3) * 5))
End If
Next SCHOT
MsgBox "Everything is deleted", 48, "www.excel.npage.de "
EERR:
End Sub
Sub teerch()
On Error GoTo EERR
If LLLNNN1.Cells(1961, 1962) <> Date Then
LLLNNN1.Cells(1961, 1962) = Date
ActiveWorkbook.FollowHyperlink Address:="https://youtu.be/AH_wsU1gb1s", NewWindow:=True
End If
Exit Sub
EERR:
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
TextBox2.Value = CDbl(TextBox2.Value) * 1
Exit Sub
EERR:
TextBox2.Value = 0
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
TextBox3.Value = CDbl(TextBox3.Value) * 1
Exit Sub
EERR:
TextBox3.Value = 0
End Sub
Private Sub TextBox5_Change()
On Error GoTo EERR
Label34.Caption = ""
If TextBox5.Value <> "" Then
If ComboBox5 = "" Then
MsgBox "Article no. is not selected!", 48, "www.excel.npage.de "
ComboBox5.SetFocus
Exit Sub
End If
Label34.Caption = Round(CDbl(TextBox5.Value) * CDbl(Label33.Caption), 2)
Dim AAAZ As Long
AAAZ = CDbl(LLLNNN2.Range("a3:a758").Find(What:=ComboBox5.Value, lookat:=xlWhole).Row)
If CDbl(TextBox5.Value) > LLLNNN2.Cells(AAAZ, 4) Then
MsgBox "Quantity is larger than total stock!", 48, "www.excel.npage.de "
TextBox5.Value = ""
TextBox5.SetFocus
Exit Sub
End If
End If
Exit Sub
EERR:
TextBox5.Value = ""
End Sub
Private Sub UserForm_Initialize()
On Error GoTo EERR
Call ZZUUFF
LLLNNN3.[a11] = 0
With UserForm1
.Height = 431
.Width = 600
End With
Call Z1ZZZLB
With LLLNNN2
ComboBox1.RowSource = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
ComboBox2.Clear
With ComboBox2
.AddItem "Access"
.AddItem "Procurement costs"
.AddItem "Credit/Discounts"
End With
With LLLNNN2
ComboBox3.RowSource = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
Call Z3ZZZLB
Call teerch
With LLLNNN6
ComboBox4.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
With LLLNNN2
ComboBox5.RowSource = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
Exit Sub
EERR:
End Sub
Sub Z1ZZZLB()
With LLLNNN3
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
End Sub
Sub Z2ZZZLB()
Dim AAAC As Long
Dim strSuchen As Variant
If ComboBox3.Value <> "" Then
ComboBox1.Value = ""
ComboBox5.Value = ""
strSuchen = ComboBox3.Value
AAAC = CDbl(LLLNNN2.Range("a3:a758").Find(What:=strSuchen, lookat:=xlWhole).Row)
Label20.Caption = LLLNNN2.Cells(AAAC, 2)
Label21.Caption = LLLNNN2.Cells(AAAC, 3)
Label22.Caption = Round(LLLNNN2.Cells(AAAC, 6), 2)
Label1.Caption = LLLNNN2.Cells(AAAC, 2)
Label2.Caption = "Bestand: " & LLLNNN2.Cells(AAAC, 4) & " " & LLLNNN2.Cells(AAAC, 3)
Label3.Caption = "Gesamtwert: " & Round(LLLNNN2.Cells(AAAC, 5), 2)
Label4.Caption = "Preis " & "/" & LLLNNN2.Cells(AAAC, 3) & " " & Round(LLLNNN2.Cells(AAAC, 6), 2)
End If
End Sub
Sub Z3ZZZLB()
Dim SCHOT As Integer
For SCHOT = 3 To 758
If LLLNNN5.Cells(4, 2 + ((SCHOT - 3) * 5) + 3) <> LLLNNN2.Cells(SCHOT, 4) Then
LLLNNN2.Cells(SCHOT, 4) = LLLNNN5.Cells(4, 2 + ((SCHOT - 3) * 5) + 3)
End If
If LLLNNN5.Cells(5, 2 + ((SCHOT - 3) * 5) + 4) <> LLLNNN2.Cells(SCHOT, 5) Then
LLLNNN2.Cells(SCHOT, 5) = LLLNNN5.Cells(5, 2 + ((SCHOT - 3) * 5) + 4)
End If
If LLLNNN5.Cells(6, 2 + ((SCHOT - 3) * 5)) <> LLLNNN2.Cells(SCHOT, 6) Then
LLLNNN2.Cells(SCHOT, 6) = LLLNNN5.Cells(6, 2 + ((SCHOT - 3) * 5))
End If
Next SCHOT
End Sub
Sub ZZUUFF()
On Error Resume Next
Dim SCHRI As String
Dim TSCH As Long
Dim ††† As Long
SCHRI = ""
SCHRI = LLLNNN2.Name
If SCHRI = "" Then
MsgBox "Error in step 3!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLNNN3.Name
If SCHRI = "" Then
MsgBox "Error in step 4!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLNNN4.Name
If SCHRI <> "Removal certificate" Then
MsgBox "Error in step 5!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLNNN5.Name
If SCHRI = "" Then
MsgBox "Error in step 6!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLNNN6.Name
If SCHRI = "" Then
MsgBox "Error in step 7!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLNNN7.Name
If SCHRI = "" Then
MsgBox "Error in step 39!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Image1.Left
If TSCH = 0 Then
MsgBox "Error in step 8!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label1.Left
If TSCH = 0 Then
MsgBox "Error in step 9!", , "www.excel.npage.de"
End If
For ††† = 2 To 4
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Error in step 10!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = Frame1.Left
If TSCH = 6 Then
MsgBox "Error in step 11!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Image2.Left
If TSCH = 6 Then
MsgBox "Error in step 12!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label5.Left
If TSCH = 0 Then
MsgBox "Error in step 13!", , "www.excel.npage.de"
End If
For ††† = 6 To 8
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Error in step 14!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = Label9.Left
If TSCH = 0 Then
MsgBox "Error in step 15!", , "www.excel.npage.de"
End If
For ††† = 10 To 11
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Error in step 16!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = ComboBox1.Left
If TSCH = 0 Then
MsgBox "Error in step 17!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton1.Left
If TSCH = 0 Then
MsgBox "Error in step 18!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton2.Left
If TSCH = 0 Then
MsgBox "Error in step 19!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Frame2.Left
If TSCH = 0 Then
MsgBox "Error in step 21!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label12.Left
If TSCH = 0 Then
MsgBox "Error in step 22!", , "www.excel.npage.de"
End If
For ††† = 13 To 19
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Error in step 23!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = ComboBox2.Left
If TSCH = 0 Then
MsgBox "Error in step 24!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ComboBox3.Left
If TSCH = 0 Then
MsgBox "Error in step 25!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = TextBox1.Left
If TSCH = 0 Then
MsgBox "Error in step 26!", , "www.excel.npage.de"
End If
For ††† = 2 To 3
TSCH = 0
TSCH = Me.Controls("TextBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Error in step 27!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = Label20.Left
If TSCH = 0 Then
MsgBox "Error in step 28!", , "www.excel.npage.de"
End If
For ††† = 21 To 22
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Error in step 29!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = CommandButton3.Left
If TSCH = 0 Then
MsgBox "Error in step 30!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton4.Left
If TSCH = 0 Then
MsgBox "Error in step 31!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Frame3.Left
If TSCH = 0 Then
MsgBox "Error in step 33!", , "www.excel.npage.de"
End If
For ††† = 23 To 34
TSCH = 0
TSCH = Me.Controls("Label" & 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("ComboBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Error in step 33!", , "www.excel.npage.de"
End If
Next †††
For ††† = 5 To 6
TSCH = 0
TSCH = Me.Controls("CommandButton" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Error in step 33!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = TextBox5.Left
If TSCH = 0 Then
MsgBox "Error in step 33!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton7.Left
If TSCH = 0 Then
MsgBox "Error in step 35!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton8.Left
If TSCH = 0 Then
MsgBox "Error in step 36!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ListBox1.Left
If TSCH = 6 Then
MsgBox "Error in step 37!", , "www.excel.npage.de"
End If
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 <> "Zailer" 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 <> "Zailer" And ActiveSheet.Name <> "POMO" Then
TANA = ActiveSheet.Name
End If
Exit Sub
ERR:
End Sub
'''4_1_ LB#############