'''1_1_ R##########
On Error GoTo EERR
Dim BLATBLAT As Integer
For BLATBLAT = 1 To Worksheets.Count
Worksheets(BLATBLAT).Activate
ActiveWindow.View = xlNormalView
Next BLATBLAT
Worksheets(1).Activate
UserForm1.Show
Exit Sub
EERR:
'''1_1_ R##########
'''2_2_R#########################################################
Sub CCOUUFAF()
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 CheckBox1_Click()
On Error Resume Next
If CheckBox1 = False Then
Exit Sub
End If
Dim ††† As Long
If CheckBox1 = True Then
CheckBox2 = False
CheckBox3 = False
CheckBox4 = False
CheckBox5 = False
CheckBox6 = False
CommandButton8.Visible = True
TextBox8.Value = ""
For ††† = 1 To 11
RRRRRR2.Cells(Rows.Count, †††).EntireColumn.AutoFit
Next †††
With ListBox1
.ColumnCount = 11
.ColumnHeads = True
.ColumnWidths = 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100
.BackColor = &HE0E0E0
End With
With RRRRRR2
ListBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 11)).Address(External:=True)
ComboBox2.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
ListBox1.ListIndex = ListBox1.ListCount - 1
If TextBox7.Value = "2" Then
If ComboBox2.Value <> "" Then
ListBox1.ListIndex = ComboBox2.ListIndex
End If
End If
If TextBox7.Value = "T" Then
If TextBox3.Value <> "" Then
††† = CDbl(RRRRRR2.Range("a2:a1048500").Find(What:=TextBox3.Value, lookat:=xlWhole).Row)
ListBox1.ListIndex = ††† - 2
End If
End If
End If
End Sub
Private Sub CheckBox2_Click()
On Error Resume Next
If CheckBox2 = False Then
Exit Sub
End If
Dim ††† As Long
If CheckBox2 = True Then
CheckBox1 = False
CheckBox3 = False
CheckBox4 = False
CheckBox5 = False
CheckBox6 = False
CommandButton8.Visible = True
TextBox8.Value = ""
For ††† = 1 To 6
RRRRRR3.Cells(Rows.Count, †††).EntireColumn.AutoFit
Next †††
With ListBox1
.ColumnCount = 6
.ColumnHeads = True
.ColumnWidths = 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100
.BackColor = &HFFFF&
End With
With RRRRRR3
ListBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 6)).Address(External:=True)
ComboBox4.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
ComboBox5.RowSource = .Range(.Cells(2, 2), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 2)).Address(External:=True)
End With
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox4.Value <> "" Then
ListBox1.ListIndex = ComboBox4.ListIndex
End If
End If
End Sub
Private Sub CheckBox3_Click()
On Error Resume Next
If CheckBox3 = False Then
Exit Sub
End If
Dim ††† As Long
If CheckBox3 = True Then
CheckBox1 = False
CheckBox2 = False
CheckBox4 = False
CheckBox5 = False
CheckBox6 = False
CommandButton8.Visible = False
TextBox8.Value = ""
For ††† = 1 To 7
RRRRRR4.Cells(Rows.Count, †††).EntireColumn.AutoFit
Next †††
With ListBox1
.ColumnCount = 7
.ColumnHeads = True
.ColumnWidths = 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100
.BackColor = &H80FF80
End With
With RRRRRR4
ListBox1.RowSource = .Range(.Cells(24, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 7)).Address(External:=True)
End With
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox3.Value <> "" Then
ListBox1.ListIndex = ComboBox3.ListIndex
End If
If ComboBox7.Value <> "" Then
ListBox1.ListIndex = ComboBox7.ListIndex
End If
End If
End Sub
Sub crrrch()
On Error GoTo EERR
If RRRRRR1.Cells(1961, 1962) <> Date Then
RRRRRR1.Cells(1961, 1962) = Date
ActiveWorkbook.FollowHyperlink Address:="https://youtu.be/s3r_t_yRbok", NewWindow:=True
End If
Exit Sub
EERR:
End Sub
Private Sub CheckBox4_Click()
On Error Resume Next
Dim ††† As Long
If CheckBox4 = False Then
Exit Sub
End If
If CheckBox4 = True Then
CheckBox1 = False
CheckBox2 = False
CheckBox3 = False
CheckBox5 = False
CheckBox6 = False
CommandButton8.Visible = True
TextBox8.Value = ""
For ††† = 1 To 11
RRRRRR5.Cells(Rows.Count, †††).EntireColumn.AutoFit
Next †††
With ListBox1
.ColumnCount = 11
.ColumnHeads = True
.ColumnWidths = 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100
.BackColor = &HE0E0E0
End With
With ListBox1
.ColumnCount = 411
.ColumnHeads = True
.BackColor = &H80C0FF
End With
With RRRRRR5
ListBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 411)).Address(External:=True)
ComboBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
ComboBox6.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
ListBox1.ListIndex = ListBox1.ListCount - 1
If TextBox7.Value = "1" Then
If ComboBox1.Value <> "" Then
ListBox1.ListIndex = ComboBox1.ListIndex
Else:
ListBox1.ListIndex = ListBox1.ListCount - 1
End If
End If
If TextBox7.Value = "6" Then
If ComboBox6.Value <> "" Then
ListBox1.ListIndex = ComboBox6.ListIndex
Else:
ListBox1.ListIndex = ListBox1.ListCount - 1
End If
End If
End If
End Sub
Private Sub CheckBox5_Click()
On Error Resume Next
If CheckBox5 = False Then
Exit Sub
End If
Dim ††† As Long
If CheckBox5 = True Then
CheckBox1 = False
CheckBox3 = False
CheckBox2 = False
CheckBox4 = False
CheckBox6 = False
CommandButton8.Visible = True
TextBox8.Value = ""
For ††† = 1 To 17
RRRRRR7.Cells(Rows.Count, †††).EntireColumn.AutoFit
Next †††
With ListBox1
.ColumnCount = 17
.ColumnHeads = True
.ColumnWidths = 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100
.BackColor = &HFFFFFF
End With
With RRRRRR7
ListBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 17)).Address(External:=True)
ComboBox9.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox9.Value <> "" Then
ListBox1.ListIndex = ComboBox9.ListIndex
Else:
ListBox1.ListIndex = ListBox1.ListCount - 1
End If
End If
End Sub
Private Sub CheckBox6_Click()
On Error Resume Next
If CheckBox6 = False Then
Exit Sub
End If
Dim ††† As Long
If CheckBox6 = True Then
CheckBox1 = False
CheckBox2 = False
CheckBox3 = False
CheckBox4 = False
CheckBox5 = False
CommandButton8.Visible = False
ComboBox1.Value = ""
ComboBox6.Value = ""
ComboBox2.Value = ""
TextBox3.Value = ""
ComboBox4.Value = ""
ComboBox5.Value = ""
Label12.Caption = ""
Label14.Caption = ""
With RRRRRR5
ComboBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
ComboBox6.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
With RRRRRR2
ComboBox2.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
With RRRRRR3
ComboBox4.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
ComboBox5.RowSource = .Range(.Cells(2, 2), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 2)).Address(External:=True)
End With
With RRRRRR7
ComboBox9.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
TextBox8.Value = ""
End If
If RRRRRR6.[r1] <> "" And RRRRRR6.[s1] <> "" Then
TextBox8.Value = "Ch6_Re"
For ††† = 1 To 11
RRRRRR6.Cells(Rows.Count, †††).EntireColumn.AutoFit
Next †††
With ListBox1
.ColumnCount = 11
.ColumnHeads = True
.ColumnWidths = 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100
.BackColor = &HE0E0E0
End With
With ListBox1
.ColumnCount = 411
.ColumnHeads = True
.BackColor = &H80C0FF
End With
With RRRRRR6
ListBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 411)).Address(External:=True)
ComboBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
ComboBox6.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox6.Value <> "" Then
ListBox1.ListIndex = ComboBox6.ListIndex
Else:
ListBox1.ListIndex = ListBox1.ListCount - 1
End If
End If
If RRRRRR6.[q1] <> "" And RRRRRR6.[r1] = "" Then
TextBox8.Value = "Ch6_Grund"
For ††† = 1 To 11
RRRRRR6.Cells(Rows.Count, †††).EntireColumn.AutoFit
Next †††
With ListBox1
.ColumnCount = 17
.ColumnHeads = True
.ColumnWidths = 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100
.BackColor = &HFFFFFF
End With
With RRRRRR6
ListBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 411)).Address(External:=True)
ComboBox9.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox6.Value <> "" Then
ListBox1.ListIndex = ComboBox9.ListIndex
Else:
ListBox1.ListIndex = ComboBox9.ListCount - 1
End If
End If
If RRRRRR6.[k1] <> "" And RRRRRR6.[L1] = "" Then
TextBox8.Value = "Ch6_Kunden"
For ††† = 1 To 11
RRRRRR6.Cells(Rows.Count, †††).EntireColumn.AutoFit
Next †††
With ListBox1
.ColumnCount = 11
.ColumnHeads = True
.ColumnWidths = 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100
.BackColor = &HE0E0E0
End With
With RRRRRR6
ListBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 411)).Address(External:=True)
ComboBox2.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox2.Value <> "" Then
ListBox1.ListIndex = ComboBox2.ListIndex
End If
If TextBox3.Value <> "" Then
††† = CDbl(RRRRRR2.Range("a2:a1048500").Find(What:=TextBox3.Value, lookat:=xlWhole).Row)
ListBox1.ListIndex = ††† - 2
End If
End If
If RRRRRR6.[F1] <> "" And RRRRRR6.[g1] = "" Then
TextBox8.Value = "Ch6_Pro"
For ††† = 1 To 6
RRRRRR6.Cells(Rows.Count, †††).EntireColumn.AutoFit
Next †††
With ListBox1
.ColumnCount = 11
.ColumnHeads = True
.ColumnWidths = 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100 & ";" & 100
.BackColor = &HFFFF&
End With
With RRRRRR6
ListBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 411)).Address(External:=True)
ComboBox4.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
ComboBox5.RowSource = .Range(.Cells(2, 2), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 2)).Address(External:=True)
End With
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox4.Value <> "" Then
ListBox1.ListIndex = ComboBox4.ListIndex
End If
If ComboBox5.Value <> "" Then
ListBox1.ListIndex = ComboBox5.ListIndex
End If
End If
End Sub
Private Sub ComboBox1_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim SCHOT As Long
Dim ††† As Long
TextBox1.Value = ""
ComboBox2.Value = ""
ComboBox3.Clear
ComboBox3.Value = ""
If ComboBox1.Value <> "" Then
ComboBox6.Value = ""
††† = CDbl(RRRRRR5.Range("a2:a1048500").Find(What:=ComboBox1.Value, lookat:=xlWhole).Row)
If RRRRRR5.Cells(†††, 2).Value <> "" And RRRRRR5.Cells(†††, 2).Value <> "_" Then
TextBox1.Value = CDate(RRRRRR5.Cells(†††, 2).Value)
End If
For SCHOT = 0 To 39
AAAC = 12 + SCHOT * 10
If RRRRRR5.Cells(†††, AAAC).Value <> "" And RRRRRR5.Cells(†††, AAAC).Value <> "_" Then
With ComboBox3
.AddItem RRRRRR5.Cells(†††, AAAC).Value
End With
End If
Next SCHOT
ComboBox2.Value = RRRRRR5.Cells(†††, 3).Value
If ListBox1.BackColor = &H80C0FF Then
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox1.Value <> "" Then
ListBox1.ListIndex = ComboBox1.ListIndex
End If
End If
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox1_Enter()
On Error GoTo EERR
TextBox7.Value = ""
TextBox7.Value = "1"
If ListBox1.BackColor = &H80C0FF And CheckBox4 = True Then
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox1.Value <> "" Then
ListBox1.ListIndex = ComboBox1.ListIndex
End If
Exit Sub
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
Dim ††† As Long
††† = CDbl(RRRRRR5.Range("a2:a1048500").Find(What:=ComboBox1.Value, lookat:=xlWhole).Row)
Exit Sub
EERR:
ComboBox1.Value = ""
End Sub
Private Sub ComboBox2_Change()
On Error GoTo EERR
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox2.Value <> "" Then
ListBox1.ListIndex = ComboBox2.ListIndex
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox2_Enter()
On Error GoTo EERR
TextBox7.Value = ""
TextBox7.Value = "2"
If ListBox1.BackColor = &HE0E0E0 And CheckBox1 = True Then
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox2.Value <> "" Then
ListBox1.ListIndex = ComboBox2.ListIndex
End If
Exit Sub
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
Dim ††† As Long
If ComboBox2.Value <> "" Then
††† = CDbl(RRRRRR2.Range("a2:a1048500").Find(What:=ComboBox2.Value, lookat:=xlWhole).Row)
End If
Exit Sub
EERR:
ComboBox2.Value = ""
End Sub
Private Sub ComboBox3_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim ††† As Long
ComboBox9.Value = ""
CommandButton1.Visible = True
If ComboBox1.Value <> "" Then
If ComboBox3.Value <> "" Then
††† = CDbl(RRRRRR5.Range("a2:a1048500").Find(What:=ComboBox1.Value, lookat:=xlWhole).Row)
AAAC = (11 + (CDbl(ComboBox3.Value) - 1) * 10) + 1
ComboBox9.Value = RRRRRR5.Cells(†††, AAAC + 9).Value
If RRRRRR5.Cells(†††, AAAC) <> "" Then
CommandButton1.Visible = False
End If
ComboBox4.Value = RRRRRR5.Cells(†††, AAAC + 1).Value
ComboBox5.Value = RRRRRR5.Cells(†††, AAAC + 2).Value
Label12.Caption = RRRRRR5.Cells(†††, AAAC + 3).Value
TextBox2.Value = RRRRRR5.Cells(†††, AAAC + 4).Value
Label13.Caption = RRRRRR5.Cells(†††, AAAC + 5).Value
Label14.Caption = RRRRRR5.Cells(†††, AAAC + 6).Value
Label15.Caption = RRRRRR5.Cells(†††, AAAC + 8).Value
End If
End If
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox3.Value <> "" Then
ListBox1.ListIndex = ComboBox3.ListIndex
Else:
ListBox1.ListIndex = ListBox1.ListCount - 1
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox3_Enter()
On Error GoTo EERR
Dim AAAC As Long
Dim SCHOT As Long
Dim ††† As Long
Dim AAAR As Long
Dim PNPN As Long
Dim strSuchen As Variant
RRRRRR4.Activate
RRRRRR4.Range("a24:g90").UnMerge
RRRRRR4.Range("a24:g90").RowHeight = 15
RRRRRR4.Range("a24:g90").Value = ""
RRRRRR4.Range("a24:g90").HorizontalAlignment = xlCenter
RRRRRR4.[g6] = ""
RRRRRR4.[g7] = ""
RRRRRR4.[g8] = ""
RRRRRR4.[g9] = ""
RRRRRR4.[a6] = ""
RRRRRR4.[a7] = ""
RRRRRR4.[a8] = ""
RRRRRR4.[a9] = ""
RRRRRR4.[a10] = ""
RRRRRR4.[a11] = ""
RRRRRR4.[a12] = ""
RRRRRR4.Range("a24:g90").Value = ""
If ComboBox1.Value <> "" Then
††† = CDbl(RRRRRR5.Range("a2:a1048500").Find(What:=ComboBox1.Value, lookat:=xlWhole).Row)
RRRRRR4.Range("a24:g90").Font.Size = 11
RRRRRR4.[g6] = RRRRRR5.Cells(†††, 3)
RRRRRR4.[g7] = ComboBox1.Value
RRRRRR4.[g8] = RRRRRR5.Cells(†††, 2)
If RRRRRR5.Cells(†††, 3) <> "" And RRRRRR5.Cells(†††, 3) <> "_" Then
strSuchen = RRRRRR5.Cells(†††, 3)
AAAR = CDbl(RRRRRR2.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
RRRRRR4.[a6] = RRRRRR2.Cells(AAAR, 2)
RRRRRR4.[a7] = RRRRRR2.Cells(AAAR, 3)
RRRRRR4.[a8] = RRRRRR2.Cells(AAAR, 4)
RRRRRR4.[a9] = RRRRRR2.Cells(AAAR, 5)
RRRRRR4.[a10] = RRRRRR2.Cells(AAAR, 6)
RRRRRR4.[a11] = RRRRRR2.Cells(AAAR, 7)
RRRRRR4.[a12] = RRRRRR2.Cells(AAAR, 8)
End If
PNPN = 24
For SCHOT = 0 To 39
AAAC = (11 + SCHOT * 10) + 1
If RRRRRR5.Cells(†††, AAAC) <> "" And RRRRRR5.Cells(†††, AAAC) <> "_" Then
RRRRRR4.Cells(PNPN, 1) = RRRRRR5.Cells(†††, AAAC)
RRRRRR4.Cells(PNPN, 2) = RRRRRR5.Cells(†††, AAAC + 1)
RRRRRR4.Cells(PNPN, 3) = RRRRRR5.Cells(†††, AAAC + 2)
RRRRRR4.Cells(PNPN, 4) = RRRRRR5.Cells(†††, AAAC + 3) & "_x_" & RRRRRR5.Cells(†††, AAAC + 4)
RRRRRR4.Cells(PNPN, 5) = RRRRRR5.Cells(†††, AAAC + 5)
RRRRRR4.Cells(PNPN, 6) = RRRRRR5.Cells(†††, AAAC + 6)
RRRRRR4.Cells(PNPN, 7) = RRRRRR5.Cells(†††, AAAC + 8)
PNPN = PNPN + 1
End If
Next SCHOT
PNPN = PNPN + 1
RRRRRR4.Cells(PNPN, 3) = "Нетто:"
RRRRRR4.Cells(PNPN + 1, 3) = "НДС.:"
RRRRRR4.Cells(PNPN + 2, 3) = "Брутто:"
RRRRRR4.Cells(PNPN + 2, 1) = "_"
RRRRRR4.Cells(PNPN, 4) = RRRRRR5.Cells(†††, 9)
RRRRRR4.Cells(PNPN + 1, 4) = RRRRRR5.Cells(†††, 10)
RRRRRR4.Cells(PNPN + 2, 4) = RRRRRR5.Cells(†††, 11)
End If
TextBox7.Value = ""
TextBox7.Value = "3"
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox3.Value <> "" Then
ListBox1.ListIndex = ComboBox3.ListIndex
Else:
ListBox1.ListIndex = ListBox1.ListCount - 1
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
Dim ††† As Long
Dim AAAC As Long
Dim KKKK As Long
Dim SCHOT As Long
If ComboBox1.Value <> "" Then
If ComboBox3.Value <> "" Then
††† = CDbl(RRRRRR5.Range("a2:a1048500").Find(What:=ComboBox1.Value, lookat:=xlWhole).Row)
KKKK = 0
For SCHOT = 0 To 39
AAAC = (11 + SCHOT * 10) + 1
If RRRRRR5.Cells(†††, AAAC) = CDbl(ComboBox3.Value) Then
KKKK = KKKK + 1
End If
Next SCHOT
If KKKK = 0 Then
ComboBox3.Value = ""
End If
End If
End If
Exit Sub
EERR:
ComboBox3.Value = ""
End Sub
Private Sub ComboBox4_Change()
On Error GoTo EERR
Dim ††† As Long
If TextBox7.Value = "4" Then
ComboBox5.Value = ""
Label12.Caption = ""
Label14.Caption = ""
If ComboBox4.Value <> "" Then
††† = CDbl(RRRRRR3.Range("a2:a1048500").Find(What:=ComboBox4.Value, lookat:=xlWhole).Row)
ComboBox5.Value = RRRRRR3.Cells(†††, 2).Value
Label12.Caption = RRRRRR3.Cells(†††, 4).Value * 1
Label14.Caption = RRRRRR3.Cells(†††, 5).Value * 1
If Label14.Caption = "" Then
Label14.Caption = 0
End If
End If
End If
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox4.Value <> "" Then
ListBox1.ListIndex = ComboBox4.ListIndex
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox4_Enter()
On Error GoTo EERR
TextBox7.Value = ""
TextBox7.Value = "4"
If ComboBox4.Value <> "" Then
††† = CDbl(RRRRRR3.Range("a2:a1048500").Find(What:=ComboBox4.Value, lookat:=xlWhole).Row)
ComboBox5.Value = RRRRRR3.Cells(†††, 2).Value
Label12.Caption = RRRRRR3.Cells(†††, 4).Value
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
Dim ††† As Long
If ComboBox4.Value <> "" Then
††† = CDbl(RRRRRR3.Range("a2:a1048500").Find(What:=ComboBox4.Value, lookat:=xlWhole).Row)
End If
Exit Sub
EERR:
ComboBox4.Value = ""
End Sub
Private Sub ComboBox5_Change()
On Error GoTo EERR
Dim ††† As Long
If TextBox7.Value = "5" Then
ComboBox4.Value = ""
Label12.Caption = ""
Label14.Caption = ""
If ComboBox5.Value <> "" Then
††† = CDbl(RRRRRR3.Range("b2:b1048500").Find(What:=ComboBox5.Value, lookat:=xlWhole).Row)
ComboBox4.Value = RRRRRR3.Cells(†††, 1).Value
Label12.Caption = RRRRRR3.Cells(†††, 4).Value
Label14.Caption = RRRRRR3.Cells(†††, 5).Value * 1
If Label14.Caption = "" Then
Label14.Caption = 0
End If
End If
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox5_Enter()
On Error GoTo EERR
TextBox7.Value = ""
TextBox7.Value = "5"
If ComboBox5.Value <> "" Then
††† = CDbl(RRRRRR3.Range("b2:b1048500").Find(What:=ComboBox5.Value, lookat:=xlWhole).Row)
ComboBox4.Value = RRRRRR3.Cells(†††, 1).Value
Label12.Caption = RRRRRR3.Cells(†††, 4).Value
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
Dim ††† As Long
If ComboBox5.Value <> "" Then
††† = CDbl(RRRRRR3.Range("b2:b1048500").Find(What:=ComboBox5.Value, lookat:=xlWhole).Row)
End If
Exit Sub
EERR:
ComboBox5.Value = ""
End Sub
Private Sub ComboBox6_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim SCHOT As Long
Dim ††† As Long
Label27.Caption = ""
TextBox3.Value = ""
ComboBox8.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
Label28.Caption = ""
Label29.Caption = ""
Label30.Caption = ""
ComboBox7.Clear
ComboBox7.Value = ""
If ComboBox6.Value <> "" Then
ComboBox1.Value = ""
††† = CDbl(RRRRRR5.Range("a2:a1048500").Find(What:=ComboBox6.Value, lookat:=xlWhole).Row)
If RRRRRR5.Cells(†††, 2).Value <> "" And RRRRRR5.Cells(†††, 2).Value <> "_" Then
Label27.Caption = CDate(RRRRRR5.Cells(†††, 2).Value)
End If
TextBox3.Value = RRRRRR5.Cells(†††, 3).Value
ComboBox8.Value = RRRRRR5.Cells(†††, 4).Value
If RRRRRR5.Cells(†††, 5).Value <> "" And RRRRRR5.Cells(†††, 5).Value <> "_" Then
TextBox4.Value = CDate(RRRRRR5.Cells(†††, 5).Value)
End If
TextBox5.Value = RRRRRR5.Cells(†††, 6).Value
TextBox6.Value = RRRRRR5.Cells(†††, 7).Value
ComboBox9.Value = RRRRRR5.Cells(†††, 8).Value
Label28.Caption = RRRRRR5.Cells(†††, 9).Value
Label29.Caption = RRRRRR5.Cells(†††, 10).Value
Label30.Caption = RRRRRR5.Cells(†††, 11).Value
For SCHOT = 0 To 39
AAAC = 12 + SCHOT * 10
If RRRRRR5.Cells(†††, AAAC).Value <> "" And RRRRRR5.Cells(†††, AAAC).Value <> "_" Then
With ComboBox7
.AddItem RRRRRR5.Cells(†††, AAAC).Value
End With
End If
Next SCHOT
End If
If ListBox1.BackColor = &H80C0FF Then
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox6.Value <> "" Then
ListBox1.ListIndex = ComboBox6.ListIndex
End If
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox6_Enter()
On Error GoTo EERR
TextBox7.Value = ""
TextBox7.Value = "6"
If ListBox1.BackColor = &H80C0FF And CheckBox4 = True Then
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox6.Value <> "" Then
ListBox1.ListIndex = ComboBox6.ListIndex
End If
Exit Sub
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
Dim ††† As Long
††† = CDbl(RRRRRR5.Range("a2:a1048500").Find(What:=ComboBox6.Value, lookat:=xlWhole).Row)
Exit Sub
EERR:
ComboBox6.Value = ""
End Sub
Private Sub ComboBox7_Change()
On Error GoTo EERR
Dim AAAC As Long
Dim ††† As Long
ComboBox9.Value = ""
If ComboBox6.Value <> "" Then
If ComboBox7.Value <> "" Then
††† = CDbl(RRRRRR5.Range("a2:a1048500").Find(What:=ComboBox6.Value, lookat:=xlWhole).Row)
AAAC = (11 + (CDbl(ComboBox7.Value) - 1) * 10) + 1
ComboBox9.Value = RRRRRR5.Cells(†††, AAAC + 9).Value
End If
End If
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox7.Value <> "" Then
ListBox1.ListIndex = ComboBox7.ListIndex
Else:
ListBox1.ListIndex = ListBox1.ListCount - 1
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox7_Enter()
On Error GoTo EERR
Dim AAAC As Long
Dim SCHOT As Long
Dim ††† As Long
Dim AAAR As Long
Dim PNPN As Long
Dim strSuchen As Variant
RRRRRR4.Activate
RRRRRR4.Range("a24:g90").UnMerge
RRRRRR4.Range("a24:g90").RowHeight = 15
RRRRRR4.Range("a24:g90").Value = ""
RRRRRR4.Range("a24:g90").HorizontalAlignment = xlCenter
RRRRRR4.[g6] = ""
RRRRRR4.[g7] = ""
RRRRRR4.[g8] = ""
RRRRRR4.[g9] = ""
RRRRRR4.[a6] = ""
RRRRRR4.[a7] = ""
RRRRRR4.[a8] = ""
RRRRRR4.[a9] = ""
RRRRRR4.[a10] = ""
RRRRRR4.[a11] = ""
RRRRRR4.[a12] = ""
RRRRRR4.Range("a24:g90").Value = ""
If ComboBox6.Value <> "" Then
††† = CDbl(RRRRRR5.Range("a2:a1048500").Find(What:=ComboBox6.Value, lookat:=xlWhole).Row)
RRRRRR4.Range("a24:g90").Font.Size = 11
RRRRRR4.[g6] = RRRRRR5.Cells(†††, 3)
RRRRRR4.[g7] = ComboBox6.Value
RRRRRR4.[g8] = RRRRRR5.Cells(†††, 2)
If RRRRRR5.Cells(†††, 3) <> "" And RRRRRR5.Cells(†††, 3) <> "_" Then
strSuchen = RRRRRR5.Cells(†††, 3)
AAAR = CDbl(RRRRRR2.Range("a2:a1048575").Find(What:=strSuchen, lookat:=xlWhole).Row)
RRRRRR4.[a6] = RRRRRR2.Cells(AAAR, 2)
RRRRRR4.[a7] = RRRRRR2.Cells(AAAR, 3)
RRRRRR4.[a8] = RRRRRR2.Cells(AAAR, 4)
RRRRRR4.[a9] = RRRRRR2.Cells(AAAR, 5)
RRRRRR4.[a10] = RRRRRR2.Cells(AAAR, 6)
RRRRRR4.[a11] = RRRRRR2.Cells(AAAR, 7)
RRRRRR4.[a12] = RRRRRR2.Cells(AAAR, 8)
End If
PNPN = 24
For SCHOT = 0 To 39
AAAC = (11 + SCHOT * 10) + 1
If RRRRRR5.Cells(†††, AAAC) <> "" And RRRRRR5.Cells(†††, AAAC) <> "_" Then
RRRRRR4.Cells(PNPN, 1) = RRRRRR5.Cells(†††, AAAC)
RRRRRR4.Cells(PNPN, 2) = RRRRRR5.Cells(†††, AAAC + 1)
RRRRRR4.Cells(PNPN, 3) = RRRRRR5.Cells(†††, AAAC + 2)
RRRRRR4.Cells(PNPN, 4) = RRRRRR5.Cells(†††, AAAC + 3) & "_x_" & RRRRRR5.Cells(†††, AAAC + 4)
RRRRRR4.Cells(PNPN, 5) = RRRRRR5.Cells(†††, AAAC + 5)
RRRRRR4.Cells(PNPN, 6) = RRRRRR5.Cells(†††, AAAC + 6)
RRRRRR4.Cells(PNPN, 7) = RRRRRR5.Cells(†††, AAAC + 8)
PNPN = PNPN + 1
End If
Next SCHOT
PNPN = PNPN + 1
RRRRRR4.Cells(PNPN, 3) = "Нетто:"
RRRRRR4.Cells(PNPN + 1, 3) = "НДС.:"
RRRRRR4.Cells(PNPN + 2, 3) = "Брутто:"
RRRRRR4.Cells(PNPN + 2, 1) = "_"
RRRRRR4.Cells(PNPN, 4) = RRRRRR5.Cells(†††, 9)
RRRRRR4.Cells(PNPN + 1, 4) = RRRRRR5.Cells(†††, 10)
RRRRRR4.Cells(PNPN + 2, 4) = RRRRRR5.Cells(†††, 11)
End If
TextBox7.Value = ""
TextBox7.Value = "3"
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox7.Value <> "" Then
ListBox1.ListIndex = ComboBox7.ListIndex
Else:
ListBox1.ListIndex = ListBox1.ListCount - 1
End If
Exit Sub
EERR:
End Sub
Sub COOUUFAF()
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 ComboBox8_Enter()
On Error GoTo EERR
TextBox7.Value = ""
TextBox7.Value = "6"
If ListBox1.BackColor = &H80C0FF And CheckBox4 = True Then
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox6.Value <> "" Then
ListBox1.ListIndex = ComboBox6.ListIndex
End If
Exit Sub
End If
Exit Sub
EERR:
End Sub
Private Sub ComboBox8_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
If ComboBox8.Value <> "Оплаченный" And ComboBox8.Value <> "Отменен" Then
ComboBox8.Value = ""
End If
Exit Sub
EERR:
ComboBox8.Value = ""
End Sub
Private Sub ComboBox9_Change()
On Error GoTo EERR
Dim ††† As Long
If ComboBox9.Value = "_" Then
ComboBox9.Value = ""
End If
If ComboBox9.Value <> "" Then
CommandButton5.Visible = True
End If
If ComboBox9.Value = "" Or ComboBox9.Value = "_" Then
CommandButton5.Visible = False
End If
If TextBox7.Value = "9" Then
If ComboBox9.Value <> "" And ComboBox9.Value <> "_" Then
††† = CDbl(RRRRRR7.Range("a2:a1048500").Find(What:=ComboBox9.Value, lookat:=xlWhole).Row)
If RRRRRR7.Cells(†††, 5) = "_" Then
ComboBox1.Value = RRRRRR7.Cells(†††, 2).Value
ComboBox3.Value = RRRRRR7.Cells(†††, 9).Value
End If
If RRRRRR7.Cells(†††, 5) <> "_" Then
ComboBox6.Value = RRRRRR7.Cells(†††, 2).Value
End If
End If
End If
If ListBox1.BackColor = &HFFFFFF Then
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox9.Value <> "" Then
ListBox1.ListIndex = ComboBox9.ListIndex
Else:
ListBox1.ListIndex = ListBox1.ListCount - 1
End If
End If
Exit Sub
EERR:
ComboBox9.Value = ""
End Sub
Private Sub ComboBox9_Enter()
On Error GoTo EERR
TextBox7.Value = ""
TextBox7.Value = "9"
If ListBox1.BackColor = &HFFFFFF And CheckBox5 = True Then
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox9.Value <> "" Then
ListBox1.ListIndex = ComboBox9.ListIndex
End If
Exit Sub
End If
Exit Sub
EERR:
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
Dim AAAC As Long
Dim PPPP As Long
Dim ††† As Long
Dim LLLZ As Long
Dim LLLC As Long
Dim GGGZ As Long
Dim KKKK As Long
Dim SCHOT As Long
Dim AAAL As Long
Dim AAAR As Long
If ComboBox1.Value = "_" Then
ComboBox1.Value = ""
End If
KKKK = 0
For SCHOT = 2 To 1048501
If KKKK = 0 Then
If RRRRRR7.Cells(SCHOT, 1).Value = "" Or RRRRRR7.Cells(SCHOT, 1).Value = "_" Then
KKKK = RRRRRR7.Cells(SCHOT, 1).Row
End If
End If
Next SCHOT
AAAR = KKKK
If AAAR > 1048500 Then
MsgBox "Журнал заполнен!", 48, "https://excel.hpage.de "
ComboBox1.SetFocus
Exit Sub
End If
ComboBox4.SetFocus
TextBox1.SetFocus
TextBox2.SetFocus
ComboBox2.SetFocus
If ComboBox4.Value = "" Then
MsgBox "Артикль не выбран!", 48, "https://excel.hpage.de "
ComboBox4.SetFocus
Exit Sub
End If
††† = CDbl(RRRRRR5.Range("a2:a1048500").Find(What:=ComboBox1.Value, lookat:=xlWhole).Row)
If RRRRRR5.Cells(†††, 4) <> "" And RRRRRR5.Cells(†††, 4) <> "_" Then
MsgBox "Этот счет уже как " & RRRRRR5.Cells(†††, 4) & " маркирован, его нельзя изменять!", 48, "https://excel.hpage.de "
ComboBox1.SetFocus
Exit Sub
End If
If TextBox2.Value = "" Then
MsgBox "Количество не указано!", 48, "https://excel.hpage.de "
TextBox2.SetFocus
Exit Sub
End If
If Label12.Caption = "" Then
MsgBox "Цена не указана!", 48, "https://excel.hpage.de "
ComboBox4.SetFocus
Exit Sub
End If
If ComboBox1.Value = "" Then
KKKK = 0
For SCHOT = 2 To 1048501
If KKKK = 0 Then
If RRRRRR5.Cells(SCHOT, 1).Value = "" Or RRRRRR5.Cells(SCHOT, 1).Value = "_" Then
KKKK = RRRRRR5.Cells(SCHOT, 1).Row
End If
End If
Next SCHOT
LLLZ = KKKK
End If
If ComboBox1.Value <> "" Then
LLLZ = CDbl(RRRRRR5.Range("a2:a1048500").Find(What:=CDbl(ComboBox1.Value), lookat:=xlWhole).Row)
End If
KKKK = 0
For SCHOT = 0 To 40
If KKKK = 0 Then
AAAC = (11 + SCHOT * 10) + 1
If RRRRRR5.Cells(LLLZ, AAAC).Value = "" Or RRRRRR5.Cells(LLLZ, AAAC).Value = "_" Then
KKKK = KKKK + 1
End If
LLLC = AAAC
PPPP = SCHOT + 1
End If
Next SCHOT
If PPPP > 40 Then
MsgBox "В одном счете программа создает только 40 позиций!", 48, "https://excel.hpage.de "
Exit Sub
End If
KKKK = 0
For SCHOT = 2 To 1048501
If KKKK = 0 Then
If RRRRRR7.Cells(SCHOT, 1).Value = "" Or RRRRRR7.Cells(SCHOT, 1).Value = "_" Then
KKKK = RRRRRR7.Cells(SCHOT, 1).Row
End If
End If
Next SCHOT
GGGZ = KKKK
If GGGZ > 1048500 Then
MsgBox "Журнал заполнен!", 48, "https://excel.hpage.de "
ComboBox10.SetFocus
Exit Sub
End If
RRRRRR7.Cells(GGGZ, 1) = GGGZ - 1
RRRRRR7.Cells(GGGZ, 2).Value = LLLZ - 1
If TextBox1.Value = "" Then
RRRRRR7.Cells(GGGZ, 3) = Date
Else:
RRRRRR7.Cells(GGGZ, 3) = CDate(TextBox1.Value)
End If
If ComboBox2.Value <> "" Then
RRRRRR7.Cells(GGGZ, 4) = ComboBox2.Value
Else:
RRRRRR7.Cells(GGGZ, 4) = "_"
End If
RRRRRR7.Cells(GGGZ, 5) = "_"
RRRRRR7.Cells(GGGZ, 6) = "_"
RRRRRR7.Cells(GGGZ, 7) = "_"
RRRRRR7.Cells(GGGZ, 8) = "_"
RRRRRR7.Cells(GGGZ, 9) = PPPP
RRRRRR7.Cells(GGGZ, 10) = ComboBox4.Value
RRRRRR7.Cells(GGGZ, 11) = ComboBox5.Value
RRRRRR7.Cells(GGGZ, 12) = CDbl(Label12.Caption)
RRRRRR7.Cells(GGGZ, 13) = CDbl(TextBox2.Value)
RRRRRR7.Cells(GGGZ, 14) = CDbl(Label13.Caption)
RRRRRR7.Cells(GGGZ, 15) = CDbl(Label14.Caption)
RRRRRR7.Cells(GGGZ, 16) = Round(RRRRRR7.Cells(GGGZ, 14) / 100 * RRRRRR7.Cells(GGGZ, 15), 2)
RRRRRR7.Cells(GGGZ, 17) = CDbl(Label15.Caption)
If TextBox1.Value = "" Then
RRRRRR5.Cells(LLLZ, 2) = Date
Else:
RRRRRR5.Cells(LLLZ, 2) = CDate(TextBox1.Value)
End If
If ComboBox2.Value <> "" Then
RRRRRR5.Cells(LLLZ, 3) = ComboBox2.Value
Else:
RRRRRR5.Cells(LLLZ, 3) = "_"
End If
RRRRRR5.Cells(LLLZ, 4) = "_"
RRRRRR5.Cells(LLLZ, 5) = "_"
RRRRRR5.Cells(LLLZ, 6) = "_"
RRRRRR5.Cells(LLLZ, 7) = "_"
RRRRRR5.Cells(LLLZ, 8) = "_"
RRRRRR5.Cells(LLLZ, LLLC) = PPPP
RRRRRR5.Cells(LLLZ, LLLC + 1) = ComboBox4.Value
RRRRRR5.Cells(LLLZ, LLLC + 2) = ComboBox5.Value
RRRRRR5.Cells(LLLZ, LLLC + 3) = CDbl(Label12.Caption)
RRRRRR5.Cells(LLLZ, LLLC + 4) = CDbl(TextBox2.Value)
RRRRRR5.Cells(LLLZ, LLLC + 5) = CDbl(Label13.Caption)
RRRRRR5.Cells(LLLZ, LLLC + 6) = CDbl(Label14.Caption)
RRRRRR5.Cells(LLLZ, LLLC + 7) = Round(RRRRRR7.Cells(GGGZ, 14) / 100 * RRRRRR7.Cells(GGGZ, 15), 2)
RRRRRR5.Cells(LLLZ, LLLC + 8) = CDbl(Label15.Caption)
RRRRRR5.Cells(LLLZ, LLLC + 9) = RRRRRR7.Cells(GGGZ, 1)
If RRRRRR5.Cells(LLLZ, 9) = "_" Then
RRRRRR5.Cells(LLLZ, 9) = ""
End If
RRRRRR5.Cells(LLLZ, 9) = Round(RRRRRR5.Cells(LLLZ, 9) + RRRRRR5.Cells(LLLZ, LLLC + 5), 2)
If RRRRRR5.Cells(LLLZ, 10) = "_" Then
RRRRRR5.Cells(LLLZ, 10) = ""
End If
RRRRRR5.Cells(LLLZ, 10) = Round(RRRRRR5.Cells(LLLZ, 10) + RRRRRR5.Cells(LLLZ, LLLC + 7), 2)
If RRRRRR5.Cells(LLLZ, 11) = "_" Then
RRRRRR5.Cells(LLLZ, 11) = ""
End If
RRRRRR5.Cells(LLLZ, 11) = Round(RRRRRR5.Cells(LLLZ, 11) + RRRRRR5.Cells(LLLZ, LLLC + 8), 2)
RRRRRR5.Cells(LLLZ, 1).Value = LLLZ - 1
With RRRRRR5
ComboBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
ComboBox6.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
ComboBox1.Value = ""
ComboBox1.Value = LLLZ - 1
ComboBox3.Value = PPPP
ComboBox1.SetFocus
ComboBox2.SetFocus
ComboBox3.SetFocus
With RRRRRR7
ComboBox9.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
Exit Sub
End Sub
Private Sub CommandButton2_Click()
On Error GoTo EERR
Dim ††† As Long
Call ComboBox3_Enter
RRRRRR5.Activate
RRRRRR5.[ov2].Select
Selection.Copy
RRRRRR4.Activate
††† = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row)
RRRRRR4.Cells(††† + 2, 1).Select
ActiveSheet.Paste
RRRRRR4.Cells(††† + 2, 1).RowHeight = RRRRRR5.[ov2].RowHeight
Application.CutCopyMode = False
RRRRRR4.Activate
ActiveSheet.Cells(Rows.Count, 1).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 2).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 3).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 4).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 5).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 6).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 7).EntireColumn.AutoFit
With ActiveSheet.PageSetup
.RightHeader = "№. Счёта: " & RRRRRR4.[g7] & " &P/&N"
End With
UserForm1.Hide
Exit Sub
EERR:
End Sub
Private Sub CommandButton3_Click()
On Error GoTo EERR
Dim ††† As Long
Dim GGGZ As Long
Dim KKKK As Long
Dim SCHOT As Long
ComboBox8.SetFocus
TextBox4.SetFocus
If ComboBox6.Value = "" Then
MsgBox " Номер счета не выбран!", 48, "https://excel.hpage.de "
ComboBox6.SetFocus
Exit Sub
End If
††† = CDbl(RRRRRR5.Range("a2:a1048500").Find(What:=ComboBox6.Value, lookat:=xlWhole).Row)
If RRRRRR5.Cells(†††, 4) <> "" And RRRRRR5.Cells(†††, 4) <> "_" Then
MsgBox "Этот счет уже как " & RRRRRR5.Cells(†††, 4) & " маркирован, его нельзя изменять!", 48, "https://excel.hpage.de "
ComboBox6.SetFocus
Exit Sub
End If
If ComboBox8.Value = "" Then
MsgBox " Тип маркировки не выбран!", 48, "https://excel.hpage.de "
ComboBox8.SetFocus
Exit Sub
End If
KKKK = 0
For SCHOT = 2 To 1048501
If KKKK = 0 Then
If RRRRRR7.Cells(SCHOT, 1).Value = "" Or RRRRRR7.Cells(SCHOT, 1).Value = "_" Then
KKKK = RRRRRR7.Cells(SCHOT, 1).Row
End If
End If
Next SCHOT
GGGZ = KKKK
If GGGZ > 1048500 Then
MsgBox "Журнал заполнен!", 48, "https://excel.hpage.de "
ComboBox10.SetFocus
Exit Sub
End If
RRRRRR7.Cells(GGGZ, 1) = GGGZ - 1
RRRRRR7.Cells(GGGZ, 2).Value = ComboBox6.Value
If Label27.Caption <> "" Then
RRRRRR7.Cells(GGGZ, 3) = CDate(Label27.Caption)
Else:
RRRRRR7.Cells(GGGZ, 3) = "_"
End If
If TextBox3.Value <> "" Then
RRRRRR7.Cells(GGGZ, 4) = TextBox3.Value
Else:
RRRRRR7.Cells(GGGZ, 4) = "_"
End If
RRRRRR7.Cells(GGGZ, 5) = ComboBox8
If TextBox4.Value <> "" Then
RRRRRR7.Cells(GGGZ, 6) = CDate(TextBox4.Value)
Else:
RRRRRR7.Cells(GGGZ, 6) = Date
End If
If TextBox5.Value <> "" Then
RRRRRR7.Cells(GGGZ, 7) = TextBox5.Value
Else:
RRRRRR7.Cells(GGGZ, 7) = "_"
End If
If TextBox6.Value <> "" Then
RRRRRR7.Cells(GGGZ, 8) = TextBox6.Value
Else:
RRRRRR7.Cells(GGGZ, 8) = "_"
End If
RRRRRR7.Cells(GGGZ, 9) = "_"
RRRRRR7.Cells(GGGZ, 10) = "_"
RRRRRR7.Cells(GGGZ, 11) = "_"
RRRRRR7.Cells(GGGZ, 12) = "_"
RRRRRR7.Cells(GGGZ, 13) = "_"
RRRRRR7.Cells(GGGZ, 14) = "_"
RRRRRR7.Cells(GGGZ, 15) = "_"
RRRRRR7.Cells(GGGZ, 16) = "_"
RRRRRR7.Cells(GGGZ, 17) = "_"
RRRRRR5.Cells(†††, 4) = ComboBox8.Value
If TextBox4.Value <> "" Then
RRRRRR5.Cells(†††, 5) = CDate(TextBox4.Value)
Else:
RRRRRR5.Cells(†††, 5) = Date
End If
If TextBox5.Value <> "" Then
RRRRRR5.Cells(†††, 6) = TextBox5.Value
Else:
RRRRRR5.Cells(†††, 6) = "_"
End If
If TextBox6.Value <> "" Then
RRRRRR5.Cells(†††, 7) = TextBox6.Value
Else:
RRRRRR5.Cells(†††, 7) = "_"
End If
RRRRRR5.Cells(†††, 8) = RRRRRR7.Cells(GGGZ, 1)
With RRRRRR7
ComboBox9.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
ComboBox6.Value = ""
ComboBox6.Value = RRRRRR5.Cells(†††, 1).Value
ComboBox6.SetFocus
ComboBox9.Value = RRRRRR7.Cells(GGGZ, 1).Value
Exit Sub
EERR:
End Sub
Private Sub CommandButton4_Click()
On Error GoTo EERR
Dim ††† As Long
Call ComboBox7_Enter
RRRRRR5.Activate
RRRRRR5.[ov2].Select
Selection.Copy
RRRRRR4.Activate
††† = CDbl(RRRRRR4.Cells(Rows.Count, 1).End(xlUp).Row)
RRRRRR4.Cells(††† + 2, 1).Select
ActiveSheet.Paste
RRRRRR4.Cells(††† + 2, 1).RowHeight = RRRRRR5.[ov2].RowHeight
Application.CutCopyMode = False
RRRRRR4.Activate
ActiveSheet.Cells(Rows.Count, 1).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 2).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 3).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 4).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 5).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 6).EntireColumn.AutoFit
ActiveSheet.Cells(Rows.Count, 7).EntireColumn.AutoFit
With ActiveSheet.PageSetup
.RightHeader = "№. Счёта: " & RRRRRR4.[g7] & " &P/&N"
End With
UserForm1.Hide
Exit Sub
EERR:
End Sub
Private Sub CommandButton5_Click()
On Error Resume Next
UserForm1.Hide
Dim SCHOT As Long
Dim AALC As Long
Dim AALZ As Long
Dim AAAR As Long
Dim ††† As Long
Dim KKKK As Long
Dim AAAA As Variant
Dim strSuchen As Variant
strSuchen = Application.InputBox("Пароль:", "https://excel.hpage.com Удалить ")
If strSuchen <> 3 Then
AAAA = MsgBox("Пароль неверен!", , "https://excel.hpage.com Удалить ")
UserForm1.Show
Exit Sub
End If
If strSuchen = False Then
UserForm1.Show
Exit Sub
Else:
††† = 0
††† = CDbl(RRRRRR7.Range("a2:a1048500").Find(What:=ComboBox9.Value, lookat:=xlWhole).Row)
If ††† = 0 Then
MsgBox "Ид.-№ не найден!", 48, "https://excel.hpage.com "
UserForm1.Show
Exit Sub
End If
If RRRRRR7.Cells(†††, 5) <> "_" Then
AALZ = CDbl(RRRRRR5.Range("a2:a1048500").Find(What:=RRRRRR7.Cells(†††, 2), lookat:=xlWhole).Row)
For AAAR = 4 To 8
RRRRRR5.Cells(AALZ, AAAR) = "_"
Next AAAR
End If
If RRRRRR7.Cells(†††, 5) = "_" Then
AALZ = CDbl(RRRRRR5.Range("a2:a1048500").Find(What:=RRRRRR7.Cells(†††, 2), lookat:=xlWhole).Row)
If RRRRRR5.Cells(AALZ, 4) <> "" And RRRRRR5.Cells(AALZ, 4) <> "_" Then
MsgBox "Этот счет уже как " & RRRRRR5.Cells(AALZ, 4) & " маркирован, его нельзя изменять!", 48, "https://excel.hpage.de "
UserForm1.Show
Exit Sub
End If
AALC = (11 + (RRRRRR7.Cells(†††, 9) - 1) * 10) + 1
RRRRRR5.Cells(AALZ, 9) = Round(RRRRRR5.Cells(AALZ, 9) - RRRRRR5.Cells(AALZ, AALC + 5), 2)
RRRRRR5.Cells(AALZ, 10) = Round(RRRRRR5.Cells(AALZ, 10) - RRRRRR5.Cells(AALZ, AALC + 7), 2)
RRRRRR5.Cells(AALZ, 11) = Round(RRRRRR5.Cells(AALZ, 11) - RRRRRR5.Cells(AALZ, AALC + 8), 2)
For AAAR = 0 To 9
RRRRRR5.Cells(AALZ, AALC + AAAR) = "_"
Next AAAR
SCHOT = 0
For AAAR = 0 To 39
AALC = (11 + AAAR * 10) + 1
If RRRRRR5.Cells(AALZ, AALC) <> "_" And RRRRRR5.Cells(AALZ, AALC) <> "" Then
SCHOT = SCHOT + 1
End If
Next AAAR
If SCHOT = 0 Then
For KKKK = 1 To 11
RRRRRR5.Cells(AALZ, KKKK) = "_"
Next KKKK
End If
End If
For AAAR = 1 To 17
RRRRRR7.Cells(†††, AAAR) = "_"
Next AAAR
With RRRRRR5
ComboBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
ComboBox6.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
With RRRRRR7
ComboBox9.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
If ComboBox1.Value <> "" Then
AAAA = ComboBox1.Value
ComboBox1.Value = ""
ComboBox1.Value = AAAA
ComboBox1.SetFocus
End If
If ComboBox6.Value <> "" Then
AAAA = ComboBox6.Value
ComboBox6.Value = ""
ComboBox6.Value = AAAA
ComboBox6.SetFocus
End If
ComboBox9.Value = ""
UserForm1.Show
End If
End Sub
Private Sub CommandButton6_Click()
On Error GoTo EERR
UserForm1.Hide
Dim AAAA As Variant
Dim strSuchen As Variant
AAAA = MsgBox("" & " Вы действительно хотите удалить все счета?" & " " & "", vbYesNo, "https://excel.hpage.de Удалить все счета")
If AAAA = vbNo Then
UserForm1.Show
Exit Sub
Else
End If
strSuchen = Application.InputBox("Пароль:", "https://excel.hpage.de Удалить все счета")
If strSuchen <> 3 Then
AAAA = MsgBox("Пароль неверен!", , "https://excel.hpage.de Удалить все счета ")
UserForm1.Show
Exit Sub
Else
End If
RRRRRR5.Range("a2:ou1048501") = ""
UserForm1.Show
EERR:
End Sub
Private Sub CommandButton7_Click()
On Error GoTo EERR
UserForm1.Hide
Dim AAAA As Variant
Dim strSuchen As Variant
AAAA = MsgBox("" & " ы действительно хотите удалить все в журнале?" & " " & "", vbYesNo, "https://excel.hpage.de Удалить все в журнале")
If AAAA = vbNo Then
UserForm1.Show
Exit Sub
Else
End If
strSuchen = Application.InputBox("Пароль:", "https://excel.hpage.de Удалить все в журнале")
If strSuchen <> 3 Then
AAAA = MsgBox("Пароль неверен!", , "https://excel.hpage.de Удалить все в журнале")
UserForm1.Show
Exit Sub
Else
End If
RRRRRR7.Range("a2:q1048501") = ""
UserForm1.Show
EERR:
End Sub
Private Sub CommandButton8_Click()
On Error GoTo EERR
Dim ††† As Long
If ListBox1.BackColor = &HFFFFFF Then
RRRRRR7.Activate
Cells.Select
Selection.Copy
RRRRRR7.[a1].Select
RRRRRR6.Activate
ActiveWindow.View = xlNormalView
RRRRRR6.AutoFilterMode = False
RRRRRR6.[a1].Select
RRRRRR6.Paste
RRRRRR6.[a1].Select
Application.CutCopyMode = False
For ††† = 1 To 17
ActiveSheet.Cells(Rows.Count, †††).EntireColumn.AutoFit
Next †††
With ActiveSheet.PageSetup
.RightHeader = " Журнал " & ": &P/&N"
End With
UserForm1.Hide
End If
If ListBox1.BackColor = &H80C0FF Then
RRRRRR5.Activate
Cells.Select
Selection.Copy
RRRRRR5.[a1].Select
RRRRRR6.Activate
ActiveWindow.View = xlNormalView
RRRRRR6.AutoFilterMode = False
RRRRRR6.[a1].Select
RRRRRR6.Paste
RRRRRR6.[a1].Select
Application.CutCopyMode = False
For ††† = 1 To 11
ActiveSheet.Cells(Rows.Count, †††).EntireColumn.AutoFit
Next †††
With ActiveSheet.PageSetup
.RightHeader = " Счета " & ": &P/&N"
End With
UserForm1.Hide
End If
If ListBox1.BackColor = &HE0E0E0 Then
RRRRRR2.Activate
Cells.Select
Selection.Copy
RRRRRR2.[a1].Select
RRRRRR6.Activate
ActiveWindow.View = xlNormalView
RRRRRR6.AutoFilterMode = False
RRRRRR6.[a1].Select
RRRRRR6.Paste
RRRRRR6.[a1].Select
Application.CutCopyMode = False
For ††† = 1 To 11
ActiveSheet.Cells(Rows.Count, †††).EntireColumn.AutoFit
Next †††
With ActiveSheet.PageSetup
.RightHeader = " База данных клиентов " & ": &P/&N"
End With
UserForm1.Hide
End If
If ListBox1.BackColor = &HFFFF& Then
RRRRRR3.Activate
Cells.Select
Selection.Copy
RRRRRR3.[a1].Select
RRRRRR6.Activate
ActiveWindow.View = xlNormalView
RRRRRR6.AutoFilterMode = False
RRRRRR6.[a1].Select
RRRRRR6.Paste
RRRRRR6.[a1].Select
Application.CutCopyMode = False
For ††† = 1 To 6
ActiveSheet.Cells(Rows.Count, †††).EntireColumn.AutoFit
Next †††
With ActiveSheet.PageSetup
.RightHeader = " Ассортимент товара " & ": &P/&N"
End With
UserForm1.Hide
End If
Exit Sub
EERR:
End Sub
Private Sub Frame1_Enter()
On Error GoTo EERR
If TextBox7.Value <> 1 And CheckBox6 = False Then
TextBox7.Value = 1
End If
Exit Sub
EERR:
End Sub
Private Sub Frame1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
TextBox7.Value = ""
Exit Sub
EERR:
End Sub
Private Sub Frame2_Enter()
On Error GoTo EERR
If TextBox7.Value <> 6 And CheckBox6 = False Then
TextBox7.Value = 6
End If
Exit Sub
EERR:
End Sub
Private Sub Frame2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
TextBox7.Value = ""
Exit Sub
EERR:
End Sub
Private Sub TextBox1_Enter()
On Error GoTo EERR
TextBox7.Value = ""
TextBox7.Value = "1"
If ListBox1.BackColor = &H80C0FF And CheckBox4 = True Then
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox1.Value <> "" Then
ListBox1.ListIndex = ComboBox1.ListIndex
End If
End If
Exit Sub
EERR:
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
If TextBox1.Value <> "" Then
TextBox1.Value = CDate(TextBox1.Value)
End If
Exit Sub
EERR:
TextBox1.Value = Date
End Sub
Private Sub TextBox2_Enter()
On Error GoTo EERR
If ListBox1.BackColor = &H80FF80 And CheckBox6 = True Then
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox3.Value <> "" Then
ListBox1.ListIndex = ComboBox3.ListIndex
End If
Exit Sub
End If
CheckBox3 = False
CheckBox3 = True
Exit Sub
EERR:
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
Label13.Caption = ""
Label15.Caption = ""
If TextBox2.Value <> "" Then
TextBox2.Value = CDbl(TextBox2.Value)
End If
If Label12.Caption <> "" Then
Label13.Caption = Round(CDbl(TextBox2.Value) * CDbl(Label12.Caption), 2)
Label15.Caption = Round(CDbl(Label13.Caption) * (CDbl(Label14.Caption) + 100) / 100, 2)
End If
Exit Sub
EERR:
TextBox2.Value = ""
End Sub
Private Sub TextBox3_Enter()
On Error GoTo EERR
Dim ††† As Long
TextBox7.Value = ""
TextBox7.Value = "T"
If ListBox1.BackColor = &HE0E0E0 And CheckBox1 = True Then
††† = CDbl(RRRRRR2.Range("a2:a1048500").Find(What:=TextBox3.Value, lookat:=xlWhole).Row)
ListBox1.ListIndex = ††† - 2
End If
Exit Sub
EERR:
End Sub
Private Sub TextBox4_Enter()
On Error GoTo EERR
TextBox7.Value = ""
TextBox7.Value = "6"
If ListBox1.BackColor = &H80C0FF And CheckBox4 = True Then
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox6.Value <> "" Then
ListBox1.ListIndex = ComboBox6.ListIndex
End If
Exit Sub
End If
Exit Sub
EERR:
End Sub
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
If TextBox4.Value <> "" Then
TextBox4.Value = CDate(TextBox4.Value)
End If
Exit Sub
EERR:
TextBox4.Value = Date
End Sub
Private Sub TextBox5_Enter()
On Error GoTo EERR
TextBox7.Value = ""
TextBox7.Value = "6"
If ListBox1.BackColor = &H80C0FF And CheckBox4 = True Then
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox6.Value <> "" Then
ListBox1.ListIndex = ComboBox6.ListIndex
End If
Exit Sub
End If
Exit Sub
EERR:
End Sub
Private Sub TextBox6_Enter()
On Error GoTo EERR
TextBox7.Value = ""
TextBox7.Value = "6"
If ListBox1.BackColor = &H80C0FF And CheckBox4 = True Then
ListBox1.ListIndex = ListBox1.ListCount - 1
If ComboBox6.Value <> "" Then
ListBox1.ListIndex = ComboBox6.ListIndex
End If
Exit Sub
End If
Exit Sub
EERR:
End Sub
Private Sub TextBox7_Change()
On Error GoTo EERR
If TextBox8.Value = "Ch6_Re" Then
Exit Sub
End If
If TextBox8.Value = "Ch6_Kunden" Then
Exit Sub
End If
If TextBox8.Value = "Ch6_Kunden" Then
Exit Sub
End If
If TextBox8.Value = "Ch6_Grund" Then
Exit Sub
End If
If TextBox8.Value = "Ch6_Pro" Then
Exit Sub
End If
If TextBox7.Value = "1" Then
CheckBox4 = True
End If
If TextBox7.Value = "2" Then
CheckBox1 = True
End If
If TextBox7.Value = "T" Then
CheckBox1 = True
End If
If TextBox7.Value = "3" Then
CheckBox3 = True
End If
If TextBox7.Value = "4" Then
CheckBox2 = True
End If
If TextBox7.Value = "5" Then
CheckBox2 = True
End If
If TextBox7.Value = "6" Then
CheckBox4 = True
End If
If TextBox7.Value = "9" Then
CheckBox5 = True
End If
Exit Sub
EERR:
End Sub
Private Sub UserForm_Initialize()
On Error GoTo EERR
Call ZZUUFF
With UserForm1
.Height = 545
.Width = 575
End With
ComboBox8.Clear
With ComboBox8
.AddItem "Оплаченный"
.AddItem "Отменен"
End With
Call crrrch
With RRRRRR5
ComboBox1.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
ComboBox6.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
With RRRRRR2
ComboBox2.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
With RRRRRR3
ComboBox4.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
ComboBox5.RowSource = .Range(.Cells(2, 2), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 2)).Address(External:=True)
End With
With RRRRRR7
ComboBox9.RowSource = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Address(External:=True)
End With
EERR:
End Sub
Sub ZZUUFF()
On Error Resume Next
Dim SCHRI As String
Dim TSCH As Long
Dim ††† As Long
SCHRI = ""
SCHRI = RRRRRR1.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге1!", , "https://excel.hpage.de"
End If
SCHRI = ""
SCHRI = RRRRRR2.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге3!", , "https://excel.hpage.de"
End If
SCHRI = ""
SCHRI = RRRRRR3.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге4!", , "https://excel.hpage.de"
End If
SCHRI = ""
SCHRI = RRRRRR4.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге5!", , "https://excel.hpage.de"
End If
SCHRI = ""
SCHRI = RRRRRR5.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге7!", , "https://excel.hpage.de"
End If
SCHRI = ""
SCHRI = RRRRRR6.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге9!", , "https://excel.hpage.de"
End If
SCHRI = ""
SCHRI = RRRRRR7.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге10!", , "https://excel.hpage.de"
End If
For ††† = 1 To 2
TSCH = 1000000
TSCH = Me.Controls("Frame" & CStr(†††)).Left
If TSCH = 1000000 Then
MsgBox "Ошибка в шаге" & 10 + ††† & "!", , "https://excel.hpage.de"
End If
Next †††
For ††† = 1 To 15
TSCH = 1000000
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 1000000 Then
MsgBox "Ошибка в шаге" & 12 + ††† & "!", , "https://excel.hpage.de"
End If
Next †††
For ††† = 1 To 5
TSCH = 1000000
TSCH = Me.Controls("ComboBox" & CStr(†††)).Left
If TSCH = 1000000 Then
MsgBox "Ошибка в шаге" & 27 + ††† & "!", , "https://excel.hpage.de"
End If
Next †††
For ††† = 1 To 2
TSCH = 1000000
TSCH = Me.Controls("TextBox" & CStr(†††)).Left
If TSCH = 1000000 Then
MsgBox "Ошибка в шаге" & 32 + ††† & "!", , "https://excel.hpage.de"
End If
Next †††
For ††† = 1 To 2
TSCH = 1000000
TSCH = Me.Controls("CommandButton" & CStr(†††)).Left
If TSCH = 1000000 Then
MsgBox "Ошибка в шаге" & 34 + ††† & "!", , "https://excel.hpage.de"
End If
Next †††
For ††† = 16 To 30
TSCH = 1000000
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 1000000 Then
MsgBox "Ошибка в шаге" & 22 + ††† & "!", , "https://excel.hpage.de"
End If
Next †††
For ††† = 6 To 8
TSCH = 1000000
TSCH = Me.Controls("ComboBox" & CStr(†††)).Left
If TSCH = 1000000 Then
MsgBox "Ошибка в шаге" & 47 + ††† & "!", , "https://excel.hpage.de"
End If
Next †††
For ††† = 3 To 6
TSCH = 1000000
TSCH = Me.Controls("TextBox" & CStr(†††)).Left
If TSCH = 1000000 Then
MsgBox "Ошибка в шаге" & 53 + ††† & "!", , "https://excel.hpage.de"
End If
Next †††
For ††† = 3 To 4
TSCH = 1000000
TSCH = Me.Controls("CommandButton" & CStr(†††)).Left
If TSCH = 1000000 Then
MsgBox "Ошибка в шаге" & 57 + ††† & "!", , "https://excel.hpage.de"
End If
Next †††
SCHRI = ""
SCHRI = Label31.Left
If SCHRI = "" Then
MsgBox "Ошибка в шаге63!", , "https://excel.hpage.de"
End If
SCHRI = ""
SCHRI = ComboBox9.Left
If SCHRI = "" Then
MsgBox "Ошибка в шаге64!", , "https://excel.hpage.de"
End If
For ††† = 5 To 8
TSCH = 1000000
TSCH = Me.Controls("CommandButton" & CStr(†††)).Left
If TSCH = 1000000 Then
MsgBox "Ошибка в шаге" & 60 + ††† & "!", , "https://excel.hpage.de"
End If
Next †††
For ††† = 1 To 6
TSCH = 1000000
TSCH = Me.Controls("CheckBox" & CStr(†††)).Left
If TSCH = 1000000 Then
MsgBox "Ошибка в шаге" & 68 + ††† & "!", , "https://excel.hpage.de"
End If
Next †††
SCHRI = ""
SCHRI = ListBox1.Left
If SCHRI = "" Then
MsgBox "Ошибка в шаге75!", , "https://excel.hpage.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
'''2_2_R#########################################################