Программу управления складом для 756 артиклей в Excel VBA самим создать
Перечень производственных этапов и коды
0_Программу управления складом для 756 артиклей в Excel VBA самим создать_Вот как это работает
1_Программу управления складом для 756 артиклей в Excel VBA самим создать_Excel файл
2_Программу управления складом для 756 артиклей в Excel VBA самим создать_Cоздать маску ввода
3_Программу управления складом для 756 артиклей в Excel VBA самим создать_Создать лист Артикли
4_Программу управления складом для 756 артиклей в Excel VBA самим создать_Создать лист Журнал1
7_Программу управления складом для 756 артиклей в Excel VBA самим создать_Создать лист Cчет артикля
8_Программу управления складом для 756 артиклей в Excel VBA самим создать_Label1
9_Программу управления складом для 756 артиклей в Excel VBA самим создать_Label2
10_Программу управления складом для 756 артиклей в Excel VBA самим создать_Label3
11_Программу управления складом для 756 артиклей в Excel VBA самим создать_Label4 - 5
12_Программу управления складом для 756 артиклей в Excel VBA самим создать_ComboBox1
13_Программу управления складом для 756 артиклей в Excel VBA самим создать_CommandButton1
14_Программу управления складом для 756 артиклей в Excel VBA самим создать_Кнопки EELL, AALL, BLFN
15_Программу управления складом для 756 артиклей в Excel VBA самим создать_CheckBox1
16_Программу управления складом для 756 артиклей в Excel VBA самим создать_TextBox ENTS
17_Программу управления складом для 756 артиклей в Excel VBA самим создать_Frame1
18_Программу управления складом для 756 артиклей в Excel VBA самим создать_Frame2 Frame3
19_Программу управления складом для 756 артиклей в Excel VBA самим создать_ListBox1
20_Программу управления складом для 756 артиклей в Excel VBA самим создать_Label6
21_Программу управления складом для 756 артиклей в Excel VBA самим создать_Label7 - Label12
22_Программу управления складом для 756 артиклей в Excel VBA самим создать_Label13
23_Программу управления складом для 756 артиклей в Excel VBA самим создать_Label14
24_Программу управления складом для 756 артиклей в Excel VBA самим создать_TextBox1
25_Программу управления складом для 756 артиклей в Excel VBA самим создать_TextBox2 TextBox3
26_Программу управления складом для 756 артиклей в Excel VBA самим создать_ComboBox2
27_Программу управления складом для 756 артиклей в Excel VBA самим создать_ComboBox3
28_Программу управления складом для 756 артиклей в Excel VBA самим создать_CommandButton2
29_Программу управления складом для 756 артиклей в Excel VBA самим создать_CommandButton3
30_Программу управления складом для 756 артиклей в Excel VBA самим создать_Label15 - Label20
31_Программу управления складом для 756 артиклей в Excel VBA самим создать_Label21 - Label22 - ENTSN
32_Программу управления складом для 756 артиклей в Excel VBA самим создать_ComboBox4 - ComboBox5
33_Программу управления складом для 756 артиклей в Excel VBA самим создать_TextBox4- TextBox5
35_Программу управления складом для 756 артиклей в Excel VBA самим создать_Label23 - Label28
36_Программу управления складом для 756 артиклей в Excel VBA самим создать_Label29 - Label30
37_Программу управления складом для 756 артиклей в Excel VBA самим создать_TextBox6- TextBox7
38_Программу управления складом для 756 артиклей в Excel VBA самим создать_ComboBox6 - ComboBox7
43_Программу управления складом для 756 артиклей в Excel VBA самим создать_Ввод кода в Userform1
'''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##########
=СУММ(D3:D758)
'''2_1_ L756##########
'''2_2_ L756##########
=СУММ(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] = "Накладная выхода артиклей"
LLLRRR4.[d13] = "№:"
If ENTS.Value <> "" Then
LLLRRR4.[e13] = ENTS.Value
Else:
LLLRRR4.[e13] = LLLRRR5.[a2]
End If
LLLRRR4.[a15] = "Позиция"
LLLRRR4.[b15] = "Дата"
LLLRRR4.[c15] = "№. Артикля"
LLLRRR4.[d15] = "Наименование"
LLLRRR4.[e15] = "Единица"
LLLRRR4.[f15] = "Количество"
LLLRRR4.[g15] = "Цена
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 = "Н.в.ар." & LLLRRR4.[e13]
If SUCHENNN <> "" Then
With LLLRRR3.Range("c9:c1048576")
Set AAAF = .Find(SUCHENNN, LookAt:=xlWhole, LookIn:=xlValues)
If Not AAAF Is Nothing Then
firstAddress = AAAF.Address
Do
AAAZ = CDbl(AAAF.Row)
AAAC = CDbl(AAAF.Column)
Worksheets("Накладная выхода артиклей").Cells(SCHET, 1) = SCHET - 15
Worksheets("Накладная выхода артиклей").Cells(SCHET, 2) = LLLRRR3.Cells(AAAZ, AAAC - 1)
Worksheets("Накладная выхода артиклей").Cells(SCHET, 3) = LLLRRR3.Cells(AAAZ, AAAC + 1)
Worksheets("Накладная выхода артиклей").Cells(SCHET, 4) = LLLRRR3.Cells(AAAZ, AAAC + 2)
Worksheets("Накладная выхода артиклей").Cells(SCHET, 5) = LLLRRR3.Cells(AAAZ, AAAC + 3)
Worksheets("Накладная выхода артиклей").Cells(SCHET, 6) = LLLRRR3.Cells(AAAZ, AAAC + 4) * -1
Worksheets("Накладная выхода артиклей").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 "Накладная выхода артиклей " & LLLRRR4.[e13] & " не существует!", 48, "www.excel.npage.de "
End If
Exit Sub
EERR:
End Sub
Private Sub CheckBox1_Click()
If CheckBox1 = True Then
ENTS.Visible = True
End If
If CheckBox1 = False Then
ENTS.Visible = False
ENTS.Value = ""
End If
End Sub
Private Sub ComboBox1_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim strSuchen As Variant
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
Label5.Caption = ""
If ComboBox1.Value <> "" Then
strSuchen = ComboBox1.Value
AAAC = CDbl(LLLRRR2.Range("a3:a758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
Label2.Caption = LLLRRR2.Cells(AAAC, 2)
Label3.Caption = "Bestand: " & LLLRRR2.Cells(AAAC, 4) & " " & LLLRRR2.Cells(AAAC, 3)
Label4.Caption = "Gesamtwert: " & Round(LLLRRR2.Cells(AAAC, 5), 2)
Label5.Caption = "Preis " & "/" & LLLRRR2.Cells(AAAC, 3) & " " & Round(LLLRRR2.Cells(AAAC, 6), 2)
End If
Exit Sub
EERR:
ComboBox1.Value = ""
End Sub
Private Sub ComboBox2_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim strSuchen As Variant
Label13.Caption = ""
Label14.Caption = ""
TextBox2.Value = ""
TextBox3.Value = ""
If ComboBox2.Value <> "" Then
strSuchen = ComboBox2.Value
AAAC = CDbl(LLLRRR2.Range("a3:a758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
ComboBox3.Value = LLLRRR2.Cells(AAAC, 2).Value
Label13.Caption = LLLRRR2.Cells(AAAC, 3)
Label14.Caption = Round(LLLRRR2.Cells(AAAC, 6), 2)
ComboBox1.Value = ComboBox2.Value
ComboBox4.Value = ""
ComboBox6.Value = ""
Else:
ComboBox3.Value = ""
End If
Exit Sub
EERR:
ComboBox2.Value = ""
ComboBox3.Value = ""
End Sub
Private Sub ComboBox3_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim strSuchen As Variant
Label13.Caption = ""
Label14.Caption = ""
TextBox2.Value = ""
TextBox3.Value = ""
If ComboBox3.Value <> "" Then
strSuchen = ComboBox3.Value
AAAC = CDbl(LLLRRR2.Range("b3:b758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
ComboBox2.Value = LLLRRR2.Cells(AAAC, 1).Value
Label13.Caption = LLLRRR2.Cells(AAAC, 3)
Label14.Caption = Round(LLLRRR2.Cells(AAAC, 6), 2)
Else:
ComboBox2.Value = ""
End If
Exit Sub
EERR:
ComboBox2.Value = ""
ComboBox3.Value = ""
End Sub
Private Sub ComboBox4_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim strSuchen As Variant
Label21.Caption = ""
Label22.Caption = ""
TextBox4.Value = ""
TextBox5.Value = ""
If ComboBox4.Value <> "" Then
strSuchen = ComboBox4.Value
AAAC = CDbl(LLLRRR2.Range("a3:a758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
ComboBox5.Value = LLLRRR2.Cells(AAAC, 2).Value
Label21.Caption = LLLRRR2.Cells(AAAC, 3)
Label22.Caption = Round(LLLRRR2.Cells(AAAC, 6), 2)
ComboBox1.Value = ComboBox4.Value
ComboBox2.Value = ""
ComboBox6.Value = ""
Else:
ComboBox5.Value = ""
End If
Exit Sub
EERR:
ComboBox4.Value = ""
ComboBox5.Value = ""
End Sub
Private Sub ComboBox5_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim strSuchen As Variant
Label21.Caption = ""
Label22.Caption = ""
TextBox4.Value = ""
TextBox5.Value = ""
If ComboBox5.Value <> "" Then
strSuchen = ComboBox5.Value
AAAC = CDbl(LLLRRR2.Range("b3:b758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
ComboBox4.Value = LLLRRR2.Cells(AAAC, 1).Value
Label21.Caption = LLLRRR2.Cells(AAAC, 3)
Label22.Caption = Round(LLLRRR2.Cells(AAAC, 6), 2)
Else:
ComboBox4.Value = ""
End If
Exit Sub
EERR:
ComboBox4.Value = ""
ComboBox5.Value = ""
End Sub
Private Sub ComboBox6_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim strSuchen As Variant
Label29.Caption = ""
Label30.Caption = ""
TextBox7.Value = ""
If ComboBox6.Value <> "" Then
strSuchen = ComboBox6.Value
AAAC = CDbl(LLLRRR2.Range("a3:a758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
ComboBox7.Value = LLLRRR2.Cells(AAAC, 2).Value
Label29.Caption = LLLRRR2.Cells(AAAC, 3)
Label30.Caption = Round(LLLRRR2.Cells(AAAC, 6), 2)
ComboBox1.Value = ComboBox6.Value
ComboBox4.Value = ""
ComboBox2.Value = ""
Else:
ComboBox7.Value = ""
End If
Exit Sub
EERR:
ComboBox6.Value = ""
ComboBox7.Value = ""
End Sub
Private Sub ComboBox7_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim strSuchen As Variant
Label29.Caption = ""
Label30.Caption = ""
TextBox7.Value = ""
If ComboBox7.Value <> "" Then
strSuchen = ComboBox7.Value
AAAC = CDbl(LLLRRR2.Range("b3:b758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
ComboBox6.Value = LLLRRR2.Cells(AAAC, 1).Value
Label29.Caption = LLLRRR2.Cells(AAAC, 3)
Label30.Caption = Round(LLLRRR2.Cells(AAAC, 6), 2)
Else:
ComboBox6.Value = ""
End If
Exit Sub
EERR:
ComboBox6.Value = ""
ComboBox7.Value = ""
End Sub
Private Sub CommandButton1_Click()
On Error GoTo EERR
Dim strSuchen As Variant
Dim SCHOT As Long
Dim AAAC As Long
Dim AAAC2 As Long
Dim AAAZ As Long
If ComboBox1 <> "" Then
LLLRRR6.Range("a1:f65530") = ""
strSuchen = ComboBox1.Value
AAAC = CDbl(LLLRRR2.Range("a3:a758").Find(What:=strSuchen, LookAt:=xlWhole).Row)
AAAC2 = 3 + (AAAC - 3) * 5
For SCHOT = 1 To 6
LLLRRR6.Cells(SCHOT, 1) = LLLRRR5.Cells(SCHOT, 2)
Next SCHOT
LLLRRR6.Cells(1, 4) = LLLRRR5.Cells(1, AAAC2)
LLLRRR6.Cells(2, 4) = LLLRRR5.Cells(2, AAAC2)
LLLRRR6.Cells(3, 4) = LLLRRR5.Cells(3, AAAC2)
LLLRRR6.Cells(4, 4) = LLLRRR5.Cells(4, AAAC2 + 3)
LLLRRR6.Cells(5, 5) = LLLRRR5.Cells(5, AAAC2 + 4)
LLLRRR6.Cells(6, 4) = LLLRRR5.Cells(6, AAAC2)
For SCHOT = 1 To 5
LLLRRR6.Cells(8, SCHOT) = LLLRRR5.Cells(11, SCHOT - 1 + AAAC2)
Next SCHOT
For SCHOT = 1 To 10000
If LLLRRR5.Cells(SCHOT - 1 + 12, AAAC2) <> "" Then
AAAZ = CDbl(LLLRRR6.Cells(Rows.Count, 1).End(xlUp).Row) + 1
LLLRRR6.Cells(AAAZ, 1) = LLLRRR5.Cells(SCHOT - 1 + 12, AAAC2)
LLLRRR6.Cells(AAAZ, 2) = LLLRRR5.Cells(SCHOT - 1 + 12, AAAC2 + 1)
LLLRRR6.Cells(AAAZ, 3) = LLLRRR5.Cells(SCHOT - 1 + 12, AAAC2 + 2)
LLLRRR6.Cells(AAAZ, 4) = LLLRRR5.Cells(SCHOT - 1 + 12, AAAC2 + 3)
LLLRRR6.Cells(AAAZ, 5) = LLLRRR5.Cells(SCHOT - 1 + 12, AAAC2 + 4)
End If
Next SCHOT
LLLRRR6.Name = “№._" & 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 "Журнал заполнен, больше места нет!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If TextBox1.Value = "" Then
MsgBox "Документ не внесён!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If ComboBox2.Value = "" Then
MsgBox "№. Артикля не внесён!", 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 " Журнал заполнен, больше места нет!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If ComboBox4.Value = "" Then
MsgBox "№. Артикля не внесён!", 48, "www.excel.npage.de "
ComboBox4.SetFocus
Exit Sub
End If
If TextBox4.Value = "" Then
MsgBox "Количество не внесёно!", 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 "Количество артикля равно нулю!", 48, "www.excel.npage.de "
ComboBox4.SetFocus
Exit Sub
End If
If LLLRRR2.Cells(†††, 4) - CDbl(TextBox4) < 0 Then
MsgBox "Товарный запас меньше, чем количество вывода!", 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) = "Н.в.ар." & LLLRRR5.[a2]
LLLRRR3.Cells(AAAZ, 3).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 4) = ComboBox4.Value
LLLRRR3.Cells(AAAZ, 4).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 5) = ComboBox5.Value
LLLRRR3.Cells(AAAZ, 5).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 6) = Label21.Caption
LLLRRR3.Cells(AAAZ, 6).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 7) = CDbl(TextBox4.Value) * -1
LLLRRR3.Cells(AAAZ, 7).HorizontalAlignment = xlCenter
LLLRRR3.Cells(AAAZ, 8) = CDbl(TextBox4.Value) * CDbl(Label22.Caption)
LLLRRR3.Cells(AAAZ, 8) = Round(LLLRRR3.Cells(AAAZ, 8), 2) * -1
LLLRRR3.Activate
LLLRRR3.Cells(AAAZ, 8).Select
LLLRRR3.Cells(AAAZ, 8).HorizontalAlignment = xlCenter
AAAR = 3 + (††† - 3) * 5
LLLRRR5.Cells(AAAZ, AAAR) = LLLRRR3.Cells(AAAZ, 1)
LLLRRR5.Cells(AAAZ, AAAR).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 1) = LLLRRR3.Cells(AAAZ, 2)
LLLRRR5.Cells(AAAZ, AAAR + 1) = Format(Date, "dd.mm.yyyy")
LLLRRR5.Cells(AAAZ, AAAR + 1).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 2) = LLLRRR3.Cells(AAAZ, 3)
LLLRRR5.Cells(AAAZ, AAAR + 2).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 3) = LLLRRR3.Cells(AAAZ, 7)
LLLRRR5.Cells(AAAZ, AAAR + 3).HorizontalAlignment = xlCenter
LLLRRR5.Cells(AAAZ, AAAR + 4) = LLLRRR3.Cells(AAAZ, 8)
LLLRRR5.Cells(AAAZ, AAAR + 4).HorizontalAlignment = xlCenter
LLLRRR5.Cells(4, AAAR + 3).FormulaR1C1 = "=SUM(R[8]C:R[65526]C)"
LLLRRR5.Cells(5, AAAR + 4).FormulaR1C1 = "=SUM(R[7]C:R[65525]C)"
LLLRRR5.Cells(4, AAAR + 3) = LLLRRR5.Cells(4, AAAR + 3).Value
LLLRRR5.Cells(5, AAAR + 4) = LLLRRR5.Cells(5, AAAR + 4).Value
If LLLRRR5.Cells(4, AAAR + 3) > 0 Then
LLLRRR5.Cells(6, AAAR) = Round(LLLRRR5.Cells(5, AAAR + 4) / LLLRRR5.Cells(4, AAAR + 3), 2)
Else:
LLLRRR5.Cells(6, AAAR) = 0
End If
Dim SCHOT As Integer
For SCHOT = 3 To 758
If LLLRRR5.Cells(4, 3 + ((SCHOT - 3) * 5) + 3) <> LLLRRR2.Cells(SCHOT, 4) Then
LLLRRR2.Cells(SCHOT, 4) = LLLRRR5.Cells(4, 3 + ((SCHOT - 3) * 5) + 3)
End If
If LLLRRR5.Cells(5, 3 + ((SCHOT - 3) * 5) + 4) <> LLLRRR2.Cells(SCHOT, 5) Then
LLLRRR2.Cells(SCHOT, 5) = LLLRRR5.Cells(5, 3 + ((SCHOT - 3) * 5) + 4)
End If
If LLLRRR5.Cells(6, 3 + ((SCHOT - 3) * 5)) <> LLLRRR2.Cells(SCHOT, 6) Then
LLLRRR2.Cells(SCHOT, 6) = LLLRRR5.Cells(6, 3 + ((SCHOT - 3) * 5))
End If
Next SCHOT
With LLLRRR3
ListBox1.RowSource = .Range(.Cells(11, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 8)).Address(External:=True)
ListBox1.ListIndex = ListBox1.ListCount - 1
End With
ComboBox1.Value = "_"
ComboBox1.Value = ComboBox4.Value
TextBox4.Value = ""
TextBox5.Value = ""
Exit Sub
EERR:
End Sub
Sub CommaaandButton5()
On Error GoTo ERR
TBB1.BackColor = &HC0FFFF
TBB2.BackColor = &HC0FFFF
KuNr.Enabled = True
KuNr.BackColor = &HC0FFFF
Dim IC As String
IC = CoB1
If CoB1 > "" Then
Sheets(IC).Activate
End If
If ActiveSheet.Name <> "Zäler" And ActiveSheet.Name <> "POMO" Then
Dim AAAZ As Variant
Dim AAAC As Variant
POMO.[a2] = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
POMO.[a3] = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Column
AAAZ = CDbl(POMO.[a2])
AAAC = CDbl(POMO.[a3])
SPALTA1 = ""
SPALTA2 = ""
SPALTA3 = ""
SPALTA4 = ""
SPALTA5 = ""
SPALTA6 = ""
SPALTA7 = ""
SPALTB1 = ""
SPALTB2 = ""
SPALTB3 = ""
SPALTB4 = ""
SPALTB5 = ""
SPALTB6 = ""
SPALTB7 = ""
SPALTC1 = ""
SPALTC2 = ""
SPALTC3 = ""
SPALTC4 = ""
SPALTC5 = ""
SPALTC6 = ""
SPALTC7 = ""
SPALTD1 = ""
SPALTD2 = ""
SPALTD3 = ""
SPALTD4 = ""
SPALTD5 = ""
SPALTD6 = ""
SPALTD7 = ""
SPALTE1 = ""
SPALTE2 = ""
SPALTE3 = ""
SPALTE4 = ""
SPALTE5 = ""
SPALTE6 = ""
SPALTE7 = ""
SPALTF1 = ""
SPALTF2 = ""
SPALTF3 = ""
SPALTF4 = ""
SPALTF5 = ""
SPALTF6 = ""
SPALTF7 = ""
SPALTG1 = ""
SPALTG2 = ""
SPALTG3 = ""
SPALTG4 = ""
SPALTG5 = ""
SPALTG6 = ""
SPALTG7 = ""
SPALTA = ""
SPALTB = ""
SPALTC = ""
SPALTD = ""
SPALTE = ""
SPALTF = ""
SPALTG = ""
KuNr = ""
TBB1.Value = ""
TBB2.Value = ""
TBB3.Value = ""
TBB4.Value = ""
TBB5.Value = ""
TBB6.Value = ""
POMO.[a1] = ""
POMO.[b1] = ""
POMO.[c1] = ""
POMO.[d1] = ""
POMO.[e1] = ""
POMO.[F1] = ""
POMO.[g1] = ""
POMO.[h1] = ""
POMO.[i1] = ""
POMO.[j1] = ""
POMO.[k1] = ""
POMO.[L1] = ""
POMO.[m1] = ""
If POMO.[a2] < 65536 Then
Dim ††† As Variant
If POMO.[a3] = 1 Then
POMO.[a4] = 0
††† = POMO.[a4]
End If
If POMO.[a3] = 7 Then
POMO.[a4] = 6
††† = POMO.[a4]
End If
SPALTA = ActiveSheet.Cells(1, AAAC - †††).Value
SPALTB = ActiveSheet.Cells(1, AAAC + 1).Value
SPALTC = ActiveSheet.Cells(1, AAAC + 2).Value
SPALTD = ActiveSheet.Cells(1, AAAC + 3).Value
SPALTE = ActiveSheet.Cells(1, AAAC + 4).Value
SPALTF = ActiveSheet.Cells(1, AAAC + 5).Value
SPALTG = ActiveSheet.Cells(1, AAAC + 6).Value
If POMO.[a2] > 8 Then
SPALTA1 = ActiveSheet.Cells(AAAZ - 6, AAAC - †††).Value
SPALTB1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 1).Value
SPALTC1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 2).Value
SPALTD1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 3).Value
SPALTE1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 4).Value
SPALTF1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 5).Value
SPALTG1 = ActiveSheet.Cells(AAAZ - 6, AAAC + 6).Value
End If
If POMO.[a2] > 7 Then
SPALTA2 = ActiveSheet.Cells(AAAZ - 5, AAAC - †††).Value
SPALTB2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 1).Value
SPALTC2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 2).Value
SPALTD2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 3).Value
SPALTE2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 4).Value
SPALTF2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 5).Value
SPALTG2 = ActiveSheet.Cells(AAAZ - 5, AAAC + 6).Value
End If
If POMO.[a2] > 6 Then
SPALTA3 = ActiveSheet.Cells(AAAZ - 4, AAAC - †††).Value
SPALTB3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 1).Value
SPALTC3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 2).Value
SPALTD3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 3).Value
SPALTE3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 4).Value
SPALTF3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 5).Value
SPALTG3 = ActiveSheet.Cells(AAAZ - 4, AAAC + 6).Value
End If
If POMO.[a2] > 5 Then
SPALTA4 = ActiveSheet.Cells(AAAZ - 3, AAAC - †††).Value
SPALTB4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 1).Value
SPALTC4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 2).Value
SPALTD4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 3).Value
SPALTE4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 4).Value
SPALTF4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 5).Value
SPALTG4 = ActiveSheet.Cells(AAAZ - 3, AAAC + 6).Value
End If
If POMO.[a2] > 4 Then
SPALTA5 = ActiveSheet.Cells(AAAZ - 2, AAAC - †††).Value
SPALTB5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 1).Value
SPALTC5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 2).Value
SPALTD5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 3).Value
SPALTE5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 4).Value
SPALTF5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 5).Value
SPALTG5 = ActiveSheet.Cells(AAAZ - 2, AAAC + 6).Value
End If
If POMO.[a2] > 3 Then
SPALTA6 = ActiveSheet.Cells(AAAZ - 1, AAAC - †††).Value
SPALTB6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 1).Value
SPALTC6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 2).Value
SPALTD6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 3).Value
SPALTE6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 4).Value
SPALTF6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 5).Value
SPALTG6 = ActiveSheet.Cells(AAAZ - 1, AAAC + 6).Value
End If
If POMO.[a2] > 2 Then
SPALTA7 = ActiveSheet.Cells(AAAZ, AAAC - †††).Value
SPALTB7 = ActiveSheet.Cells(AAAZ, AAAC + 1).Value
SPALTC7 = ActiveSheet.Cells(AAAZ, AAAC + 2).Value
SPALTD7 = ActiveSheet.Cells(AAAZ, AAAC + 3).Value
SPALTE7 = ActiveSheet.Cells(AAAZ, AAAC + 4).Value
SPALTF7 = ActiveSheet.Cells(AAAZ, AAAC + 5).Value
SPALTG7 = ActiveSheet.Cells(AAAZ, AAAC + 6).Value
End If
End If
End If
If ActiveSheet.Name <> "Zäler" And ActiveSheet.Name <> "POMO" Then
TANA = ActiveSheet.Name
End If
Exit Sub
ERR:
End Sub
Sub trkrch()
On Error GoTo EERR
If LLLRRR1.Cells(1961, 1962) <> Date Then
LLLRRR1.Cells(1961, 1962) = Date
ActiveWorkbook.FollowHyperlink Address:="https://youtu.be/opIEJOuozH8", NewWindow:=True
End If
Exit Sub
EERR:
End Sub
Private Sub CommandButton5_Click()
On Error GoTo EERR
Dim AAAA As Variant
LLLRRR4.Activate
Unload Me
AAAA = MsgBox("Хотите удалить содержимое накладной выхода артиклей и назначить новый номер накладной?", vbYesNo, "www.excel.npage.de Номер накладной ")
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 "Журнал заполнен, больше места нет!", 48, "www.excel.npage.de "
TextBox1.SetFocus
Exit Sub
End If
If TextBox6.Value = "" Then
MsgBox "Документ не внесён!", 48, "www.excel.npage.de "
TextBox6.SetFocus
Exit Sub
End If
If ComboBox6.Value = "" Then
MsgBox "№. Артикля не внесён!", 48, "www.excel.npage.de "
ComboBox6.SetFocus
Exit Sub
End If
If TextBox7.Value = "" Then
MsgBox "Цена не внесена!", 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("" & "Вы действительно хотите удалить запись?" _
& "", vbYesNo, "www.excel.npage.de Удалить запись")
If AAAA = vbNo Then
Exit Sub
Else
End If
strSuchen = Application.InputBox _
("Пароль:", "www.excel.npage.de Удалить запись ")
If strSuchen <> 3 Then
MS = MsgBox("Пароль неверен", , "www.excel.npage.de Удалить запись")
Exit Sub
Else
End If
strSuchen = Application.InputBox _
("Введите желаемый идентификационный номер", "www.excel.npage.de Удалить запись ")
If strSuchen = False Then
AAAA = MsgBox("Этот идентификационный номер не существует!", , "www.excel.npage.de Удалить запись")
Exit Sub
End If
If strSuchen = 0 Then
AAAA = MsgBox("Этот идентификационный номер (0) не существует!", , "www.excel.npage.de Удалить запись")
Exit Sub
End If
If strSuchen = "" Then
AAAA = MsgBox("Введите желаемый идентификационный номер", , "www.excel.npage.de Удалить запись")
Exit Sub
End If
If strSuchen = False Then
Exit Sub
Else
ActiveSheet.Range("a11:a65530").Cells.Find(What:=strSuchen, LookAt:=xlWhole).Activate
strFrage = MsgBox("Хотите эту запись: " & _
"Ид.-№.-" & ActiveCell.Value & "; " & _
"Дата-" & ActiveCell.Offset(0, 1) & "; " & _
"Документ-" & ActiveCell.Offset(0, 2) & "; " & _
"удалить?", _
vbYesNo, "www.excel.npage.de Удалить запись")
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("Этот идентификационный номер не существует!", , "www.excel.npage.de Удалить запись")
End If
End If
LLLRRR1.Activate
Exit Sub
EERR:
LLLRRR1.Activate
AAAA = MsgBox("Этот идентификационный номер не существует!", , "www.excel.npage.de ")
End Sub
Private Sub AALL_Click()
On Error GoTo EERR
Unload Me
Dim AAAA As Variant
AAAA = MsgBox("" & "Вы действительно хотите всё удалить?" & " " & "", vbYesNo, "www.excel.npage.de Всё удалить")
If AAAA = vbNo Then
Exit Sub
Else
End If
strSuchen = Application.InputBox("Пароль:", "www.excel.npage.de Всё удалить ")
If strSuchen <> 3 Then
AAAA = MsgBox("Пароль неверен", , "www.excel.npage.de Всё удалить")
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 "Всё удалено!", 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 "Ошибка в шаге 3!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLRRR3.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге 4!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLRRR4.Name
If SCHRI <> "Накладная выхода артиклей" Then
MsgBox "Ошибка в шаге 5!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLRRR5.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге 6!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = LLLRRR6.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге 7!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label1.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 8!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label2.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 9!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label3.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 10!", , "www.excel.npage.de"
End If
For ††† = 4 To 5
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 11!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = ComboBox1.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 12!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton1.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 13!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = EELL.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 14!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = AALL.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 14!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = BLFN.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 14!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CheckBox1.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 15!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ENTS.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 16!", , "www.excel.npage.de"
End If
For ††† = 1 To 3
TSCH = 1
TSCH = Me.Controls("Frame" & CStr(†††)).Left
If TSCH = 1 Then
MsgBox "Ошибка в шаге 17-18!", , "www.excel.npage.de"
End If
Next †††
TSCH = 11
TSCH = ListBox1.Left
If TSCH = 11 Then
MsgBox "Ошибка в шаге 19!", , "www.excel.npage.de"
End If
For ††† = 6 To 12
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 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 "Ошибка в шаге 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 "Ошибка в шаге 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 "Ошибка в шаге 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 "Ошибка в шаге 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 "Ошибка в шаге 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 "Ошибка в шаге 31!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = ENTSN.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 31!", , "www.excel.npage.de"
End If
For ††† = 4 To 5
TSCH = 0
TSCH = Me.Controls("ComboBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге 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 "Ошибка в шаге 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 "Ошибка в шаге 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 "Ошибка в шаге 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 "Ошибка в шаге 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 "Ошибка в шаге 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 "Ошибка в шаге 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 "Ошибка в шаге 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#######################