Программу учёта рабочего времени в Excel VBA самостоятельно создать
Перечень производственных этапов и коды
0_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Вот как это работает
1_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Excel файл
2_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Cоздать маску ввода
3_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Создать лист Календарь
4_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Создать лист Календарь
5_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Создать лист Формуляр
6_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Создать лист Легенда
7_Программу учёта рабочего времени в Excel VBA самостоятельно создать_CommandButton1
8_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Frame1
9_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label1
10_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label2
11_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label3 - 26
12_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label27
13_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label28 - 33
14_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label34 - 59
15_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label60 - 66
16_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label67 - 92
17_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label93 - 99
18_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label100 - 125
19_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label126 - 132
20_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label133 - 158
21_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label159 - 165
22_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label166 - 191
23_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label192 - 198
24_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label199 - 224
25_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label225 - 231
26_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label232 - 233
27_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label234 – Label238
28_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label239 – Label241
29_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label242 и ComboBox1
30_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label243 и ComboBox2
31_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label244
32_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label245 – Label249
33_Программу учёта рабочего времени в Excel VBA самостоятельно создать_ComboBox3
34_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label250 - Label253
35_Программу учёта рабочего времени в Excel VBA самостоятельно создать_ComboBox4 - ComboBox5
36_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label254 - Label256
37_Программу учёта рабочего времени в Excel VBA самостоятельно создать_ComboBox6 - ComboBox8
38_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Ряд времени
39_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Ряд десятичных чисел
40_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label257 - Label261
41_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label262 - Label265
42_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label266 - Label272
43_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label273 - Label277
44_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label278 - Label284
45_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Label285 - Label290
46_Программу учёта рабочего времени в Excel VBA самостоятельно создать_CommandButton2
47_Программу учёта рабочего времени в Excel VBA самостоятельно создать_CommandButton3
48_Программу учёта рабочего времени в Excel VBA самостоятельно создать_CommandButton4
49_Программу учёта рабочего времени в Excel VBA самостоятельно создать_CommandButton5
50_Программу учёта рабочего времени в Excel VBA самостоятельно создать_ Скрыть лист Формуляр
51_Программу учёта рабочего времени в Excel VBA самостоятельно создать_ Порядок активации в Frame1
52_Программу учёта рабочего времени в Excel VBA самостоятельно создать_Code in Userform1 eintragen
'''1_1_Z##########
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_Z##########
''''2_1_Z##########
Sub AZZUUFAF()
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 <> "Zlr" 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 <> "Zlr" And ActiveSheet.Name <> "POMO" Then
TANA = ActiveSheet.Name
End If
Exit Sub
ERR:
End Sub
Private Sub ComboBox1_Change()
On Error GoTo EERR
Dim AAAZ As Long
Dim IIII%
Dim V_N$
ComboBox2.Clear
ZZZRRR4.[e2] = ZZZRRR4.[e2] * 1
Label240 = ""
Label241 = ""
If ComboBox1.Value <> "" Then
AAAZ = CDbl(ZZZRRR3.Range("a5:a370").Cells.Find(What:=ComboBox1.Value, lookat:=xlWhole).Row)
Label240 = ZZZRRR3.Cells(AAAZ, 5)
Label241 = ZZZRRR3.Cells(AAAZ, 5) * ZZZRRR4.[e2]
With ComboBox2
For IIII = 1 To 31
If ZZZRRR3.Cells(AAAZ + IIII, 1) <> "" Then
V_N = ZZZRRR3.Cells(AAAZ + IIII, 1)
.AddItem V_N
End If
Next IIII
End With
End If
For IIII = 1 To 25
Me.Controls("Label" & CStr(IIII + 1)) = ""
Me.Controls("Label" & CStr(IIII + 1)).BackColor = &HFFFFFF
Me.Controls("Label" & CStr(IIII + 1 + 33)) = ""
Me.Controls("Label" & CStr(IIII + 1 + 33)).BackColor = &HFFFFFF
Me.Controls("Label" & CStr(IIII + 1 + 66)) = ""
Me.Controls("Label" & CStr(IIII + 1 + 99)) = ""
Me.Controls("Label" & CStr(IIII + 1 + 132)) = ""
Me.Controls("Label" & CStr(IIII + 1 + 165)) = ""
Me.Controls("Label" & CStr(IIII + 1 + 198)) = ""
Next IIII
If ComboBox1.Value <> "" Then
For IIII = 1 To 25
Me.Controls("Label" & CStr(IIII + 1)) = ZZZRRR3.Cells(AAAZ + IIII, 1)
Me.Controls("Label" & CStr(IIII + 1 + 33)) = ZZZRRR3.Cells(AAAZ + IIII, 2)
Me.Controls("Label" & CStr(IIII + 1 + 66)) = ZZZRRR3.Cells(AAAZ + IIII, 4)
Me.Controls("Label" & CStr(IIII + 1 + 99)) = ZZZRRR3.Cells(AAAZ + IIII, 6)
Me.Controls("Label" & CStr(IIII + 1 + 132)) = ZZZRRR3.Cells(AAAZ + IIII, 9)
Me.Controls("Label" & CStr(IIII + 1 + 165)) = ZZZRRR3.Cells(AAAZ + IIII, 10)
Me.Controls("Label" & CStr(IIII + 1 + 198)) = ZZZRRR3.Cells(AAAZ + IIII, 15)
If ZZZRRR3.Cells(AAAZ + IIII, 3).Font.ColorIndex = 3 Then
Me.Controls("Label" & CStr(IIII + 1)).BackColor = &HFF&
End If
If ZZZRRR3.Cells(AAAZ + IIII, 3).Font.ColorIndex = 1 Then
Me.Controls("Label" & CStr(IIII + 1)).BackColor = &HE0E0E0
End If
If ZZZRRR3.Cells(AAAZ + IIII, 2) = "Сб" Then
Me.Controls("Label" & CStr(IIII + 1 + 33)).BackColor = &H80FF&
End If
If ZZZRRR3.Cells(AAAZ + IIII, 2) = "Вс" Then
Me.Controls("Label" & CStr(IIII + 1 + 33)).BackColor = &HFF&
End If
Next IIII
End If
For IIII = 26 To 31
Me.Controls("Label" & CStr(IIII + 2)) = ""
Me.Controls("Label" & CStr(IIII + 2)).BackColor = &HFFFFFF
Me.Controls("Label" & CStr(IIII + 2 + 33)) = ""
Me.Controls("Label" & CStr(IIII + 2 + 33)).BackColor = &HFFFFFF
Me.Controls("Label" & CStr(IIII + 2 + 66)) = ""
Me.Controls("Label" & CStr(IIII + 2 + 99)) = ""
Me.Controls("Label" & CStr(IIII + 2 + 132)) = ""
Me.Controls("Label" & CStr(IIII + 2 + 165)) = ""
Me.Controls("Label" & CStr(IIII + 2 + 198)) = ""
Next IIII
If ComboBox1.Value <> "" Then
For IIII = 26 To 31
Me.Controls("Label" & CStr(IIII + 2)) = ZZZRRR3.Cells(AAAZ + IIII, 1)
Me.Controls("Label" & CStr(IIII + 2 + 33)) = ZZZRRR3.Cells(AAAZ + IIII, 2)
Me.Controls("Label" & CStr(IIII + 2 + 66)) = ZZZRRR3.Cells(AAAZ + IIII, 4)
Me.Controls("Label" & CStr(IIII + 2 + 99)) = ZZZRRR3.Cells(AAAZ + IIII, 6)
Me.Controls("Label" & CStr(IIII + 2 + 132)) = ZZZRRR3.Cells(AAAZ + IIII, 9)
Me.Controls("Label" & CStr(IIII + 2 + 165)) = ZZZRRR3.Cells(AAAZ + IIII, 10)
Me.Controls("Label" & CStr(IIII + 2 + 198)) = ZZZRRR3.Cells(AAAZ + IIII, 15)
If ZZZRRR3.Cells(AAAZ + IIII, 3).Font.ColorIndex = 3 Then
Me.Controls("Label" & CStr(IIII + 2)).BackColor = &HFF&
End If
If ZZZRRR3.Cells(AAAZ + IIII, 3).Font.ColorIndex = 1 Then
Me.Controls("Label" & CStr(IIII + 2)).BackColor = &HE0E0E0
End If
If ZZZRRR3.Cells(AAAZ + IIII, 2) = "Сб" Then
Me.Controls("Label" & CStr(IIII + 2 + 33)).BackColor = &H80FF&
End If
If ZZZRRR3.Cells(AAAZ + IIII, 2) = "Вс" Then
Me.Controls("Label" & CStr(IIII + 2 + 33)).BackColor = &HFF&
End If
Next IIII
End If
If ComboBox1.Value <> "" Then
For IIII = 1 To 31
ZZZRRR3.Cells(AAAZ + IIII, 16) = ZZZRRR4.[e2]
If ZZZRRR3.Cells(AAAZ + IIII, 3).Font.ColorIndex = 3 Then
ZZZRRR3.Cells(AAAZ + IIII, 16) = ""
End If
If ZZZRRR3.Cells(AAAZ + IIII, 2) = "Сб" Then
ZZZRRR3.Cells(AAAZ + IIII, 16) = ""
End If
If ZZZRRR3.Cells(AAAZ + IIII, 2) = "Вс" Then
ZZZRRR3.Cells(AAAZ + IIII, 16) = ""
End If
Next IIII
ZZZRRR3.Cells(AAAZ + 32, 16) = ZZZRRR3.Cells(AAAZ, 5) * ZZZRRR4.[e2]
End If
If ComboBox1.Value <> "" Then
CommandButton4.Enabled = True
Else
CommandButton4.Enabled = False
End If
Call ZeitStunden
Call ZVerlauf
Exit Sub
EERR:
ZZZRRR4.Activate
ZZZRRR4.[e2].Select
MsgBox "Продолжительность рабочего дня не указано!", 48, "www.excel.npage.de"
UserForm1.Hide
End Sub
Private Sub ComboBox2_Change()
On Error GoTo EERR
Dim IIII%
Dim AAAZ As Long
Label244.Caption = ""
For IIII = 1 To 25
Me.Controls("Label" & CStr(IIII + 1 + 66)).BackColor = &HFFFFFF
Next IIII
For IIII = 26 To 31
Me.Controls("Label" & CStr(IIII + 2 + 66)).BackColor = &HFFFFFF
Next IIII
If ComboBox2.Value <> "" Then
For IIII = 1 To 25
If Me.Controls("Label" & CStr(IIII + 1)) = ComboBox2.Value Then
Me.Controls("Label" & CStr(IIII + 1 + 66)).BackColor = &HFFFF&
End If
Next IIII
For IIII = 26 To 32
If Me.Controls("Label" & CStr(IIII + 2)) = ComboBox2.Value Then
Me.Controls("Label" & CStr(IIII + 2 + 66)).BackColor = &HFFFF&
End If
Next IIII
AAAZ = CDbl(ZZZRRR3.Range("a5:a400").Cells.Find(What:=CDate(ComboBox2.Value), lookat:=xlWhole).Row)
Label244.Caption = ZZZRRR3.Cells(AAAZ, 3)
End If
If ComboBox2.Value <> "" Then
CommandButton3.Enabled = True
Else
CommandButton3.Enabled = False
End If
Dim GGG1 As Integer
If ComboBox2.Value <> "" Then
ComboBox3.Enabled = True
ComboBox3.Clear
For GGG1 = 2 To 101
With ComboBox3
.AddItem ZZZRRR4.Cells(GGG1, 1).Value
End With
Next GGG1
Else
ComboBox3.Value = ""
ComboBox3.Enabled = False
End If
If ComboBox2.Value <> "" Then
ComboBox4.Enabled = True
ComboBox4.Clear
For GGG1 = 2 To 101
With ComboBox4
.AddItem ZZZRRR4.Cells(GGG1, 3).Value
End With
Next GGG1
Else
ComboBox4.Enabled = False
ComboBox4.Value = ""
End If
If ComboBox2.Value <> "" Then
ComboBox5.Enabled = True
ComboBox5.Clear
For GGG1 = 2 To 101
With ComboBox5
.AddItem ZZZRRR4.Cells(GGG1, 4).Value
End With
Next GGG1
Else
ComboBox5.Enabled = False
ComboBox5.Value = ""
End If
If ComboBox2.Value <> "" Then
ComboBox6.Enabled = True
ComboBox6.Clear
For GGG1 = 2 To 1441
With ComboBox6
.AddItem CDate(ZZZRRR3.Cells(GGG1, 20).Value)
End With
Next GGG1
Else
ComboBox6.Enabled = False
ComboBox6.Value = ""
End If
If ComboBox2.Value <> "" Then
ComboBox7.Enabled = True
ComboBox7.Clear
For GGG1 = 2 To 1441
With ComboBox7
.AddItem CDate(ZZZRRR3.Cells(GGG1, 20).Value)
End With
Next GGG1
Else
ComboBox7.Enabled = False
ComboBox7.Value = ""
End If
If ComboBox2.Value <> "" Then
ComboBox8.Enabled = True
ComboBox8.Clear
For GGG1 = 2 To 1441
With ComboBox8
.AddItem CDate(ZZZRRR3.Cells(GGG1, 20).Value)
End With
Next GGG1
Else
ComboBox8.Enabled = False
ComboBox8.Value = ""
End If
Call ZeitStunden
Call ZVerlauf
Exit Sub
EERR:
End Sub
Private Sub ComboBox3_Change()
On Error GoTo EERR
Dim AAAZ As Long
Dim AAAC As Long
Dim NOMMER As Long
Label247.Caption = ""
Label248.Caption = ""
Label249.Caption = ""
If ComboBox3.Value <> "" Then
AAAZ = CDbl(ZZZRRR4.Range("a2:a101").Cells.Find(What:=ComboBox3.Value, lookat:=xlWhole).Row)
Label246.Caption = ZZZRRR4.Cells(AAAZ, 2)
AAAZ = CDbl(ZZZRRR3.Range("a5:a400").Cells.Find(What:=CDate(ComboBox2.Value), lookat:=xlWhole).Row)
AAAC = 6
ZZZRRR3.[xfd6].FormulaR1C1 = "=SUM(R[1]C:R[394]C)"
ZZZRRR3.Range("xfd7:xfd400") = ""
For NOMMER = 7 To 400
If Label246.Caption <> "" Then
If ZZZRRR3.Cells(NOMMER, AAAC).Value = Label246.Caption Then
ZZZRRR3.Cells(NOMMER, 16384).Value = 1
End If
End If
Next NOMMER
Label247.Caption = "Im ganzen Jahr__________ " & ZZZRRR3.[xfd6].Value & " " & Label246.Caption
ZZZRRR3.[xfc6].FormulaR1C1 = "=SUM(R[1]C:R[394]C)"
ZZZRRR3.Range("xfc7:xfc400") = ""
For NOMMER = 7 To AAAZ
If Label246.Caption <> "" Then
If ZZZRRR3.Cells(NOMMER, AAAC).Value = Label246.Caption Then
ZZZRRR3.Cells(NOMMER, 16383).Value = 1
End If
End If
Next NOMMER
Label248.Caption = "JahreСбnfang bis Datum_________ " & ZZZRRR3.[xfc6].Value & " " & Label246.Caption
ZZZRRR3.[xfb6].FormulaR1C1 = "=SUM(R[1]C:R[394]C)"
ZZZRRR3.Range("xfb7:xfb400") = ""
For NOMMER = AAAZ To 400
If Label246.Caption <> "" Then
If ZZZRRR3.Cells(NOMMER, AAAC).Value = Label246.Caption Then
ZZZRRR3.Cells(NOMMER, 16382).Value = 1
End If
End If
Next NOMMER
Label249.Caption = "Datum bis Jahresende____ " & ZZZRRR3.[xfb6].Value & " " & Label246.Caption
If Label246.Caption = "" Then
Label247.Caption = ""
Label248.Caption = ""
Label249.Caption = ""
End If
Else
Label246.Caption = ""
End If
Exit Sub
EERR:
Label246.Caption = ""
ComboBox3.Value = ""
End Sub
Private Sub ComboBox5_Change()
If ComboBox5.Value <> "" Then
CommandButton2.Enabled = True
Else
CommandButton2.Enabled = False
End If
End Sub
Private Sub ComboBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
ZZZRRR3.[w2] = ""
Dim AAAZ As Long
If ComboBox6.Value <> "" Then
AAAZ = CDbl(ZZZRRR3.Range("t2:t1441").Cells.Find(What:=CDate(ComboBox6.Value), lookat:=xlWhole).Row)
ZZZRRR3.[w2] = ZZZRRR3.Cells(AAAZ, 21).Value
End If
Exit Sub
EERR:
ZZZRRR3.[w2] = ""
ComboBox6.Value = ""
MsgBox "Время было неправильным!", 48, "www.excel.npage.de"
End Sub
Private Sub ComboBox7_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
ZZZRRR3.[x2] = ""
Dim AAAZ As Long
If ComboBox7.Value <> "" Then
AAAZ = CDbl(ZZZRRR3.Range("t2:t1441").Cells.Find(What:=CDate(ComboBox7.Value), lookat:=xlWhole).Row)
ZZZRRR3.[x2] = ZZZRRR3.Cells(AAAZ, 21).Value
End If
Exit Sub
EERR:
ZZZRRR3.[x2] = ""
ComboBox7.Value = ""
MsgBox "Время было неправильным!", 48, "www.excel.npage.de"
End Sub
Private Sub ComboBox8_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EERR
ZZZRRR3.[y2] = ""
Dim AAAZ As Long
If ComboBox8.Value <> "" Then
AAAZ = CDbl(ZZZRRR3.Range("t2:t1441").Cells.Find(What:=CDate(ComboBox8.Value), lookat:=xlWhole).Row)
ZZZRRR3.[y2] = ZZZRRR3.Cells(AAAZ, 21).Value
End If
Exit Sub
EERR:
ZZZRRR3.[y2] = ""
ComboBox8.Value = ""
MsgBox "Время было неправильным!", 48, "www.excel.npage.de"
End Sub
Private Sub CommandButton1_Click()
On Error GoTo EERR
Unload Me
Dim DAT As Long, JAHR As Integer
JAHR = InputBox("Введите 4-значное цифровое обозначение года", "www.excel.npage.de", IIf(Month(Date) > 9, Year(Date) + 1, Year(Date)))
Dim IIII%
ZZZRRR2.Activate
Range("A7").Select
ActiveCell.FormulaR1C1 = "1/1/" & JAHR
Range("A8").Select
ActiveCell.FormulaR1C1 = "1/2/" & JAHR
Range("A7:A8").Select
Selection.AutoFill Destination:=Range("A7:A37"), Type:=xlFillDefault
For IIII = 7 To 37
ActiveSheet.Cells(IIII, 1).Activate
ActiveCell.Offset(0, 1) = Format(ActiveCell, "ddd")
Next IIII
Range("A40").Select
ActiveCell.FormulaR1C1 = "2/1/" & JAHR
Range("A41").Select
ActiveCell.FormulaR1C1 = "2/2/" & JAHR
Range("A40:A41").Select
Selection.AutoFill Destination:=Range("A40:A68"), Type:=xlFillDefault
For IIII = 40 To 68
ActiveSheet.Cells(IIII, 1).Activate
ActiveCell.Offset(0, 1) = Format(ActiveCell, "ddd")
Next IIII
Range("A73").Select
ActiveCell.FormulaR1C1 = "3/1/" & JAHR
Range("A74").Select
ActiveCell.FormulaR1C1 = "3/2/" & JAHR
Range("A73:A74").Select
Selection.AutoFill Destination:=Range("A73:A103"), Type:=xlFillDefault
For IIII = 73 To 103
ActiveSheet.Cells(IIII, 1).Activate
ActiveCell.Offset(0, 1) = Format(ActiveCell, "ddd")
Next IIII
If CDate(Cells(68, 1)) = CDate(Cells(73, 1)) Then
Cells(68, 1) = ""
Cells(68, 2) = ""
End If
Range("A106").Select
ActiveCell.FormulaR1C1 = "4/1/" & JAHR
Range("A107").Select
ActiveCell.FormulaR1C1 = "4/2/" & JAHR
Range("A106:A107").Select
Selection.AutoFill Destination:=Range("A106:A135"), Type:=xlFillDefault
For IIII = 106 To 135
ActiveSheet.Cells(IIII, 1).Activate
ActiveCell.Offset(0, 1) = Format(ActiveCell, "ddd")
Next IIII
Range("A139").Select
ActiveCell.FormulaR1C1 = "5/1/" & JAHR
Range("A140").Select
ActiveCell.FormulaR1C1 = "5/2/" & JAHR
Range("A139:A140").Select
Selection.AutoFill Destination:=Range("A139:A169"), Type:=xlFillDefault
For IIII = 139 To 169
ActiveSheet.Cells(IIII, 1).Activate
ActiveCell.Offset(0, 1) = Format(ActiveCell, "ddd")
Next IIII
Range("A172").Select
ActiveCell.FormulaR1C1 = "6/1/" & JAHR
Range("A173").Select
ActiveCell.FormulaR1C1 = "6/2/" & JAHR
Range("A172:A173").Select
Selection.AutoFill Destination:=Range("A172:A201"), Type:=xlFillDefault
For IIII = 172 To 201
ActiveSheet.Cells(IIII, 1).Activate
ActiveCell.Offset(0, 1) = Format(ActiveCell, "ddd")
Next IIII
Range("A205").Select
ActiveCell.FormulaR1C1 = "7/1/" & JAHR
Range("A206").Select
ActiveCell.FormulaR1C1 = "7/2/" & JAHR
Range("A205:A206").Select
Selection.AutoFill Destination:=Range("A205:A235"), Type:=xlFillDefault
For IIII = 205 To 235
ActiveSheet.Cells(IIII, 1).Activate
ActiveCell.Offset(0, 1) = Format(ActiveCell, "ddd")
Next IIII
Range("A238").Select
ActiveCell.FormulaR1C1 = "8/1/" & JAHR
Range("A239").Select
ActiveCell.FormulaR1C1 = "8/2/" & JAHR
Range("A238:A239").Select
Selection.AutoFill Destination:=Range("A238:A268"), Type:=xlFillDefault
For IIII = 238 To 268
ActiveSheet.Cells(IIII, 1).Activate
ActiveCell.Offset(0, 1) = Format(ActiveCell, "ddd")
Next IIII
Range("A271").Select
ActiveCell.FormulaR1C1 = "9/1/" & JAHR
Range("A272").Select
ActiveCell.FormulaR1C1 = "9/2/" & JAHR
Range("A271:A272").Select
Selection.AutoFill Destination:=Range("A271:A300"), Type:=xlFillDefault
For IIII = 271 To 300
ActiveSheet.Cells(IIII, 1).Activate
ActiveCell.Offset(0, 1) = Format(ActiveCell, "ddd")
Next IIII
Range("A304").Select
ActiveCell.FormulaR1C1 = "10/1/" & JAHR
Range("A305").Select
ActiveCell.FormulaR1C1 = "10/2/" & JAHR
Range("A304:A305").Select
Selection.AutoFill Destination:=Range("A304:A334"), Type:=xlFillDefault
For IIII = 304 To 334
ActiveSheet.Cells(IIII, 1).Activate
ActiveCell.Offset(0, 1) = Format(ActiveCell, "ddd")
Next IIII
Range("A337").Select
ActiveCell.FormulaR1C1 = "11/1/" & JAHR
Range("A338").Select
ActiveCell.FormulaR1C1 = "11/2/" & JAHR
Range("A337:A338").Select
Selection.AutoFill Destination:=Range("A337:A366"), Type:=xlFillDefault
For IIII = 337 To 366
ActiveSheet.Cells(IIII, 1).Activate
ActiveCell.Offset(0, 1) = Format(ActiveCell, "ddd")
Next IIII
Range("A370").Select
ActiveCell.FormulaR1C1 = "12/1/" & JAHR
Range("A371").Select
ActiveCell.FormulaR1C1 = "12/2/" & JAHR
Range("A370:A371").Select
Selection.AutoFill Destination:=Range("A370:A400"), Type:=xlFillDefault
For IIII = 370 To 400
ActiveSheet.Cells(IIII, 1).Activate
ActiveCell.Offset(0, 1) = Format(ActiveCell, "ddd")
Next IIII
ActiveSheet.Range("b7:b400").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Dim GGG2 As Object, GGG3 As Object, GGG4 As Object
For Each GGG3 In ActiveSheet.Range("b7:b400")
If GGG3 <> "Сб" And GGG3 <> "Вс" Then '
GGG3.Interior.ColorIndex = xlColorIndexNone
End If
Next GGG3
For Each GGG2 In ActiveSheet.Range("b7:b400")
If GGG2 = "Вс" Then
GGG2.Interior.ColorIndex = 3
End If
Next GGG2
For Each GGG4 In ActiveSheet.Range("b7:b400")
If GGG4 = "Сб" Then '
GGG4.Interior.ColorIndex = 44
End If
Next GGG4
ActiveSheet.Range("c7:c400").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
ZZZRRR2.Activate
ZZZRRR2.[c7].Select
ActiveCell.FormulaR1C1 = "=WEEKNUM(RC[-2],21)"
Range("C7").Select
Selection.AutoFill Destination:=Range("C7:C400"), Type:=xlFillDefault
Range("C7:C400").Select
ActiveWindow.SmallScroll Down:=-27
Range("C367:C369").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-30
Range("C335:C336").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-36
Range("C301:C303").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-30
Range("C269:C270").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-30
Range("C236:C237").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-36
Range("C203:C204").Select
Selection.ClearContents
Range("C202").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-39
Range("C170:C171").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-30
Range("C137:C138").Select
Selection.ClearContents
Range("C136").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-33
Range("C104:C105").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-33
Range("C69:C72").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-33
Range("C38:C39").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-33
Range("C6").Select
If ActiveSheet.[a68] = "" Then
ActiveSheet.[c68] = ""
End If
Dim LLLL As Long
For LLLL = 7 To 400
ZZZRRR2.Cells(LLLL, 4).Value = ZZZRRR2.Cells(LLLL, 3).Value
Next LLLL
ActiveSheet.Range("c7:c400").Value = ""
ActiveSheet.Range("c7:c400").Font.ColorIndex = 0
ZZZRRR2.[c7] = "Новый год"
ZZZRRR2.[c7].Font.ColorIndex = 3
ZZZRRR2.[c12] = "Три святых короля"
ZZZRRR2.[c12].Font.ColorIndex = 1
ZZZRRR2.[c139] = "Первое мая"
ZZZRRR2.[c139].Font.ColorIndex = 3
ZZZRRR2.[c252] = "Вознесение Девы Марии"
ZZZRRR2.[c252].Font.ColorIndex = 1
ZZZRRR2.[c306] = "Воссоединение Германии"
ZZZRRR2.[c306].Font.ColorIndex = 3
ZZZRRR2.[c334] = "День Реформации"
ZZZRRR2.[c334].Font.ColorIndex = 3
ZZZRRR2.[c337] = "Праздник всех Cвятых"
ZZZRRR2.[c337].Font.ColorIndex = 3
ZZZRRR2.[c393] = "Рождественский Cочельник"
ZZZRRR2.[c393].Font.ColorIndex = 1
ZZZRRR2.[c394] = "1. день Рождества"
ZZZRRR2.[c394].Font.ColorIndex = 3
ZZZRRR2.[c395] = "2. день Рождества"
ZZZRRR2.[c395].Font.ColorIndex = 3
Dim FFF As Object
For Each FFF In ZZZRRR2.Range("b353:b359")
If FFF = "Ср" Then
FFF.Offset(0, 1).Value = "День покаяния"
FFF.Offset(0, 1).Font.ColorIndex = 1
End If
Next FFF
Dim OOO As Date
Dim AAA As Integer, bbb As Integer, CCC As Integer, DDD As Integer, EEE As Integer
Dim TAG As Integer, MONAT As Integer
AAA = JAHR Mod 19
bbb = JAHR Mod 4
CCC = JAHR Mod 7
DDD = (19 * AAA + 24) Mod 30
EEE = (2 * bbb + 4 * CCC + 6 * DDD + 5) Mod 7
TAG = 22 + DDD + EEE
MONAT = 3
If TAG > 31 Then
TAG = DDD + EEE - 9
MONAT = 4
ElseIf TAG = 26 And MONAT = 4 Then
TAG = 19
ElseIf TAG = 25 And MONAT = 4 And DDD = 28 And EEE = 6 And AAA > 10 Then
TAG = 18
End If
OOO = DateSerial(Year:=JAHR, Month:=MONAT, Day:=TAG)
ZZZRRR2.[c65536] = OOO
ZZZRRR2.[c65535] = OOO + 1
ZZZRRR2.[c65534] = OOO - 2
ZZZRRR2.[c65533] = OOO + 39
ZZZRRR2.[c65532] = OOO + 49
ZZZRRR2.[c65531] = OOO + 50
ZZZRRR2.[c65530] = OOO + 60
ZZZRRR2.[c65529] = OOO - 46
ZZZRRR2.[c65528] = OOO - 48
ZZZRRR2.[d65536] = "Пасха"
ZZZRRR2.[d65535] = "Второй день Пасхи"
ZZZRRR2.[d65534] = "Страстная пятница"
ZZZRRR2.[d65533] = "Вознесение Христа"
ZZZRRR2.[d65532] = "Троица"
ZZZRRR2.[d65531] = "Второй день Троицы"
ZZZRRR2.[d65530] = "Праздник Тела Христова"
ZZZRRR2.[d65529] = "Первая среда Великого Поста"
ZZZRRR2.[d65528] = "Карнавал"
For Each FFF In ZZZRRR2.Range("a7:a400")
If FFF = ZZZRRR2.[c65536] Then
FFF.Offset(0, 2).Value = FFF.Offset(0, 2).Value & " " & ZZZRRR2.[d65536].Value
FFF.Offset(0, 2).Font.ColorIndex = 3
End If
If FFF = ZZZRRR2.[c65535] Then
FFF.Offset(0, 2).Value = FFF.Offset(0, 2).Value & " " & ZZZRRR2.[d65535].Value
FFF.Offset(0, 2).Font.ColorIndex = 3
End If
If FFF = ZZZRRR2.[c65534] Then
FFF.Offset(0, 2).Value = FFF.Offset(0, 2).Value & " " & ZZZRRR2.[d65534].Value
FFF.Offset(0, 2).Font.ColorIndex = 3
End If
If FFF = ZZZRRR2.[c65533] Then
FFF.Offset(0, 2).Value = FFF.Offset(0, 2).Value & " " & ZZZRRR2.[d65533].Value
FFF.Offset(0, 2).Font.ColorIndex = 3
End If
If FFF = ZZZRRR2.[c65532] Then
FFF.Offset(0, 2).Value = FFF.Offset(0, 2).Value & " " & ZZZRRR2.[d65532].Value
FFF.Offset(0, 2).Font.ColorIndex = 3
End If
If FFF = ZZZRRR2.[c65531] Then
FFF.Offset(0, 2).Value = FFF.Offset(0, 2).Value & " " & ZZZRRR2.[d65531].Value
FFF.Offset(0, 2).Font.ColorIndex = 3
End If
If FFF = ZZZRRR2.[c65530] Then
FFF.Offset(0, 2).Value = FFF.Offset(0, 2).Value & " " & ZZZRRR2.[d65530].Value
FFF.Offset(0, 2).Font.ColorIndex = 3
End If
If FFF = ZZZRRR2.[c65529] Then
FFF.Offset(0, 2).Value = ZZZRRR2.[d65529].Value
FFF.Offset(0, 2).Font.ColorIndex = 1
End If
If FFF = ZZZRRR2.[c65528] Then
FFF.Offset(0, 2).Value = ZZZRRR2.[d65528].Value
FFF.Offset(0, 2).Font.ColorIndex = 1
End If
Next FFF
ZZZRRR2.Range("c65528:d65536") = ""
ZZZRRR2.[e6] = ""
For IIII = 7 To 37
If ZZZRRR2.Cells(IIII, 2).Value <> "Сб" And ZZZRRR2.Cells(IIII, 2).Value <> "Вс" And ZZZRRR2.Cells(IIII, 3).Font.ColorIndex <> 3 Then
ZZZRRR2.[e6] = ZZZRRR2.[e6] + 1
End If
Next IIII
ZZZRRR2.[e39] = ""
For IIII = 40 To 68
If ZZZRRR2.Cells(IIII, 2).Value <> "" And ZZZRRR2.Cells(IIII, 2).Value <> "Сб" And ZZZRRR2.Cells(IIII, 2).Value <> "Вс" And ZZZRRR2.Cells(IIII, 3).Font.ColorIndex <> 3 Then
ZZZRRR2.[e39] = ZZZRRR2.[e39] + 1
End If
Next IIII
ZZZRRR2.[e72] = ""
For IIII = 73 To 103
If ZZZRRR2.Cells(IIII, 2).Value <> "Сб" And ZZZRRR2.Cells(IIII, 2).Value <> "Вс" And ZZZRRR2.Cells(IIII, 3).Font.ColorIndex <> 3 Then
ZZZRRR2.[e72] = ZZZRRR2.[e72] + 1
End If
Next IIII
ZZZRRR2.[e105] = ""
For IIII = 106 To 135
If ZZZRRR2.Cells(IIII, 2).Value <> "Сб" And ZZZRRR2.Cells(IIII, 2).Value <> "Вс" And ZZZRRR2.Cells(IIII, 3).Font.ColorIndex <> 3 Then
ZZZRRR2.[e105] = ZZZRRR2.[e105] + 1
End If
Next IIII
ZZZRRR2.[e138] = ""
For IIII = 139 To 169
If ZZZRRR2.Cells(IIII, 2).Value <> "Сб" And ZZZRRR2.Cells(IIII, 2).Value <> "Вс" And ZZZRRR2.Cells(IIII, 3).Font.ColorIndex <> 3 Then
ZZZRRR2.[e138] = ZZZRRR2.[e138] + 1
End If
Next IIII
ZZZRRR2.[e171] = ""
For IIII = 172 To 201
If ZZZRRR2.Cells(IIII, 2).Value <> "Сб" And ZZZRRR2.Cells(IIII, 2).Value <> "Вс" And ZZZRRR2.Cells(IIII, 3).Font.ColorIndex <> 3 Then
ZZZRRR2.[e171] = ZZZRRR2.[e171] + 1
End If
Next IIII
ZZZRRR2.[e204] = ""
For IIII = 205 To 235
If ZZZRRR2.Cells(IIII, 2).Value <> "Сб" And ZZZRRR2.Cells(IIII, 2).Value <> "Вс" And ZZZRRR2.Cells(IIII, 3).Font.ColorIndex <> 3 Then
ZZZRRR2.[e204] = ZZZRRR2.[e204] + 1
End If
Next IIII
ZZZRRR2.[e237] = ""
For IIII = 238 To 268
If ZZZRRR2.Cells(IIII, 2).Value <> "Сб" And ZZZRRR2.Cells(IIII, 2).Value <> "Вс" And ZZZRRR2.Cells(IIII, 3).Font.ColorIndex <> 3 Then
ZZZRRR2.[e237] = ZZZRRR2.[e237] + 1
End If
Next IIII
ZZZRRR2.[e270] = ""
For IIII = 271 To 300
If ZZZRRR2.Cells(IIII, 2).Value <> "Сб" And ZZZRRR2.Cells(IIII, 2).Value <> "Вс" And ZZZRRR2.Cells(IIII, 3).Font.ColorIndex <> 3 Then
ZZZRRR2.[e270] = ZZZRRR2.[e270] + 1
End If
Next IIII
ZZZRRR2.[e303] = ""
For IIII = 304 To 334
If ZZZRRR2.Cells(IIII, 2).Value <> "Сб" And ZZZRRR2.Cells(IIII, 2).Value <> "Вс" And ZZZRRR2.Cells(IIII, 3).Font.ColorIndex <> 3 Then
ZZZRRR2.[e303] = ZZZRRR2.[e303] + 1
End If
Next IIII
ZZZRRR2.[e336] = ""
For IIII = 337 To 366
If ZZZRRR2.Cells(IIII, 2).Value <> "Сб" And ZZZRRR2.Cells(IIII, 2).Value <> "Вс" And ZZZRRR2.Cells(IIII, 3).Font.ColorIndex <> 3 Then
ZZZRRR2.[e336] = ZZZRRR2.[e336] + 1
End If
Next IIII
ZZZRRR2.[e369] = ""
For IIII = 370 To 400
If ZZZRRR2.Cells(IIII, 2).Value <> "Сб" And ZZZRRR2.Cells(IIII, 2).Value <> "Вс" And ZZZRRR2.Cells(IIII, 3).Font.ColorIndex <> 3 Then
ZZZRRR2.[e369] = ZZZRRR2.[e369] + 1
End If
Next IIII
ZZZRRR2.Range("A5:E403").Select
Selection.Copy
ZZZRRR3.Activate
ZZZRRR3.Range("A5").Select
ActiveSheet.Paste
ZZZRRR3.Range("A4").Select
ZZZRRR2.Activate
ZZZRRR2.Range("A2").Select
Application.CutCopyMode = False
Unload Me
Exit Sub
EERR:
End Sub
Sub ColmmandButton()
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 <> "Zlr" 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 <> "Zlr" And ActiveSheet.Name <> "POMO" Then
TANA = ActiveSheet.Name
End If
Exit Sub
ERR:
End Sub
Private Sub CommandButton2_Click()
On Error GoTo EERR
Dim AAAC As Long
Dim AAAC2 As Long
Dim AAAZ2 As Long
Dim OBOBOB As Object
Dim SCHOT As Long
Dim AAAC3 As Long
AAAC = 6
AAAZ = CDbl(ZZZRRR3.Range("a5:a400").Cells.Find(What:=ComboBox1.Value, lookat:=xlWhole).Row)
ZZZRRR2.Range("f7:q38").Value = ""
ZZZRRR2.Range("f40:q71").Value = ""
ZZZRRR2.Range("f73:q104").Value = ""
ZZZRRR2.Range("f106:q137").Value = ""
ZZZRRR2.Range("f139:q170").Value = ""
ZZZRRR2.Range("f172:q203").Value = ""
ZZZRRR2.Range("f205:q236").Value = ""
ZZZRRR2.Range("f238:q269").Value = ""
ZZZRRR2.Range("f271:q302").Value = ""
ZZZRRR2.Range("f304:q335").Value = ""
ZZZRRR2.Range("f337:q368").Value = ""
ZZZRRR2.Range("f370:q401").Value = ""
ZZZRRR2.Range("f403:q403").Value = ""
ZZZRRR3.Activate
For Each OBOBOB In ZZZRRR3.Range(Cells(6, AAAC + 2), Cells(400, AAAC + 2))
If ComboBox5.Value <> "" Then
If OBOBOB = ComboBox5.Value Then '
AAAC2 = CDbl(OBOBOB.Column)
AAAZ2 = CDbl(OBOBOB.Row)
AAAC3 = (AAAC2 / AAAC2) + 7
ZZZRRR2.Cells(AAAZ2, AAAC3 - 1).Value = ZZZRRR3.Cells(AAAZ2, AAAC2 - 1).Value
ZZZRRR2.Cells(AAAZ2, AAAC3 - 2).Value = ZZZRRR3.Cells(AAAZ2, AAAC2 - 2).Value
ZZZRRR2.Cells(AAAZ2, AAAC3).Value = ZZZRRR3.Cells(AAAZ2, AAAC2).Value
ZZZRRR2.Cells(AAAZ2, AAAC3 + 1).Value = ZZZRRR3.Cells(AAAZ2, AAAC2 + 1).Value
ZZZRRR2.Cells(AAAZ2, AAAC3 + 2).Value = ZZZRRR3.Cells(AAAZ2, AAAC2 + 2).Value
ZZZRRR2.Cells(AAAZ2, AAAC3 + 3).Value = ZZZRRR3.Cells(AAAZ2, AAAC2 + 3).Value
ZZZRRR2.Cells(AAAZ2, AAAC3 + 4).Value = ZZZRRR3.Cells(AAAZ2, AAAC2 + 4).Value
ZZZRRR2.Cells(AAAZ2, AAAC3 + 5).Value = ZZZRRR3.Cells(AAAZ2, AAAC2 + 5).Value
ZZZRRR2.Cells(AAAZ2, AAAC3 + 6).Value = ZZZRRR3.Cells(AAAZ2, AAAC2 + 6).Value
ZZZRRR2.Cells(AAAZ2, AAAC3 + 7).Value = ZZZRRR3.Cells(AAAZ2, AAAC2 + 7).Value
ZZZRRR2.Cells(AAAZ2, AAAC3 + 8).Value = ZZZRRR3.Cells(AAAZ2, AAAC2 + 8).Value
ZZZRRR2.Cells(AAAZ2, AAAC3 + 9).Value = ZZZRRR3.Cells(AAAZ2, AAAC2 + 9).Value
End If
End If
Next OBOBOB
For SCHOT = 0 To 30
ZZZRRR2.Cells(38, 12).Value = ZZZRRR2.Cells(38, 12).Value + ZZZRRR2.Cells(7 + SCHOT, 12).Value
ZZZRRR2.Cells(71, 12).Value = ZZZRRR2.Cells(71, 12).Value + ZZZRRR2.Cells(40 + SCHOT, 12).Value
ZZZRRR2.Cells(104, 12).Value = ZZZRRR2.Cells(104, 12).Value + ZZZRRR2.Cells(73 + SCHOT, 12).Value
ZZZRRR2.Cells(137, 12).Value = ZZZRRR2.Cells(137, 12).Value + ZZZRRR2.Cells(106 + SCHOT, 12).Value
ZZZRRR2.Cells(170, 12).Value = ZZZRRR2.Cells(170, 12).Value + ZZZRRR2.Cells(139 + SCHOT, 12).Value
ZZZRRR2.Cells(203, 12).Value = ZZZRRR2.Cells(203, 12).Value + ZZZRRR2.Cells(172 + SCHOT, 12).Value
ZZZRRR2.Cells(236, 12).Value = ZZZRRR2.Cells(236, 12).Value + ZZZRRR2.Cells(205 + SCHOT, 12).Value
ZZZRRR2.Cells(269, 12).Value = ZZZRRR2.Cells(269, 12).Value + ZZZRRR2.Cells(238 + SCHOT, 12).Value
ZZZRRR2.Cells(302, 12).Value = ZZZRRR2.Cells(302, 12).Value + ZZZRRR2.Cells(271 + SCHOT, 12).Value
ZZZRRR2.Cells(335, 12).Value = ZZZRRR2.Cells(335, 12).Value + ZZZRRR2.Cells(304 + SCHOT, 12).Value
ZZZRRR2.Cells(368, 12).Value = ZZZRRR2.Cells(368, 12).Value + ZZZRRR2.Cells(337 + SCHOT, 12).Value
ZZZRRR2.Cells(401, 12).Value = ZZZRRR2.Cells(401, 12).Value + ZZZRRR2.Cells(370 + SCHOT, 12).Value
ZZZRRR2.Cells(38, 13).Value = ZZZRRR2.Cells(38, 13).Value + ZZZRRR2.Cells(7 + SCHOT, 13).Value
ZZZRRR2.Cells(71, 13).Value = ZZZRRR2.Cells(71, 13).Value + ZZZRRR2.Cells(40 + SCHOT, 13).Value
ZZZRRR2.Cells(104, 13).Value = ZZZRRR2.Cells(104, 13).Value + ZZZRRR2.Cells(73 + SCHOT, 13).Value
ZZZRRR2.Cells(137, 13).Value = ZZZRRR2.Cells(137, 13).Value + ZZZRRR2.Cells(106 + SCHOT, 13).Value
ZZZRRR2.Cells(170, 13).Value = ZZZRRR2.Cells(170, 13).Value + ZZZRRR2.Cells(139 + SCHOT, 13).Value
ZZZRRR2.Cells(203, 13).Value = ZZZRRR2.Cells(203, 13).Value + ZZZRRR2.Cells(172 + SCHOT, 13).Value
ZZZRRR2.Cells(236, 13).Value = ZZZRRR2.Cells(236, 13).Value + ZZZRRR2.Cells(205 + SCHOT, 13).Value
ZZZRRR2.Cells(269, 13).Value = ZZZRRR2.Cells(269, 13).Value + ZZZRRR2.Cells(238 + SCHOT, 13).Value
ZZZRRR2.Cells(302, 13).Value = ZZZRRR2.Cells(302, 13).Value + ZZZRRR2.Cells(271 + SCHOT, 13).Value
ZZZRRR2.Cells(335, 13).Value = ZZZRRR2.Cells(335, 13).Value + ZZZRRR2.Cells(304 + SCHOT, 13).Value
ZZZRRR2.Cells(368, 13).Value = ZZZRRR2.Cells(368, 13).Value + ZZZRRR2.Cells(337 + SCHOT, 13).Value
ZZZRRR2.Cells(401, 13).Value = ZZZRRR2.Cells(401, 13).Value + ZZZRRR2.Cells(370 + SCHOT, 13).Value
ZZZRRR2.Cells(38, 14).Value = ZZZRRR2.Cells(38, 14).Value + ZZZRRR2.Cells(7 + SCHOT, 14).Value
ZZZRRR2.Cells(71, 14).Value = ZZZRRR2.Cells(71, 14).Value + ZZZRRR2.Cells(40 + SCHOT, 14).Value
ZZZRRR2.Cells(104, 14).Value = ZZZRRR2.Cells(104, 14).Value + ZZZRRR2.Cells(73 + SCHOT, 14).Value
ZZZRRR2.Cells(137, 14).Value = ZZZRRR2.Cells(137, 14).Value + ZZZRRR2.Cells(106 + SCHOT, 14).Value
ZZZRRR2.Cells(170, 14).Value = ZZZRRR2.Cells(170, 14).Value + ZZZRRR2.Cells(139 + SCHOT, 14).Value
ZZZRRR2.Cells(203, 14).Value = ZZZRRR2.Cells(203, 14).Value + ZZZRRR2.Cells(172 + SCHOT, 14).Value
ZZZRRR2.Cells(236, 14).Value = ZZZRRR2.Cells(236, 14).Value + ZZZRRR2.Cells(205 + SCHOT, 14).Value
ZZZRRR2.Cells(269, 14).Value = ZZZRRR2.Cells(269, 14).Value + ZZZRRR2.Cells(238 + SCHOT, 14).Value
ZZZRRR2.Cells(302, 14).Value = ZZZRRR2.Cells(302, 14).Value + ZZZRRR2.Cells(271 + SCHOT, 14).Value
ZZZRRR2.Cells(335, 14).Value = ZZZRRR2.Cells(335, 14).Value + ZZZRRR2.Cells(304 + SCHOT, 14).Value
ZZZRRR2.Cells(368, 14).Value = ZZZRRR2.Cells(368, 14).Value + ZZZRRR2.Cells(337 + SCHOT, 14).Value
ZZZRRR2.Cells(401, 14).Value = ZZZRRR2.Cells(401, 14).Value + ZZZRRR2.Cells(370 + SCHOT, 14).Value
ZZZRRR2.Cells(38, 15).Value = ZZZRRR2.Cells(38, 15).Value + ZZZRRR2.Cells(7 + SCHOT, 15).Value
ZZZRRR2.Cells(71, 15).Value = ZZZRRR2.Cells(71, 15).Value + ZZZRRR2.Cells(40 + SCHOT, 15).Value
ZZZRRR2.Cells(104, 15).Value = ZZZRRR2.Cells(104, 15).Value + ZZZRRR2.Cells(73 + SCHOT, 15).Value
ZZZRRR2.Cells(137, 15).Value = ZZZRRR2.Cells(137, 15).Value + ZZZRRR2.Cells(106 + SCHOT, 15).Value
ZZZRRR2.Cells(170, 15).Value = ZZZRRR2.Cells(170, 15).Value + ZZZRRR2.Cells(139 + SCHOT, 15).Value
ZZZRRR2.Cells(203, 15).Value = ZZZRRR2.Cells(203, 15).Value + ZZZRRR2.Cells(172 + SCHOT, 15).Value
ZZZRRR2.Cells(236, 15).Value = ZZZRRR2.Cells(236, 15).Value + ZZZRRR2.Cells(205 + SCHOT, 15).Value
ZZZRRR2.Cells(269, 15).Value = ZZZRRR2.Cells(269, 15).Value + ZZZRRR2.Cells(238 + SCHOT, 15).Value
ZZZRRR2.Cells(302, 15).Value = ZZZRRR2.Cells(302, 15).Value + ZZZRRR2.Cells(271 + SCHOT, 15).Value
ZZZRRR2.Cells(335, 15).Value = ZZZRRR2.Cells(335, 15).Value + ZZZRRR2.Cells(304 + SCHOT, 15).Value
ZZZRRR2.Cells(368, 15).Value = ZZZRRR2.Cells(368, 15).Value + ZZZRRR2.Cells(337 + SCHOT, 15).Value
ZZZRRR2.Cells(401, 15).Value = ZZZRRR2.Cells(401, 15).Value + ZZZRRR2.Cells(370 + SCHOT, 15).Value
ZZZRRR2.Cells(38, 16).Value = ZZZRRR2.Cells(38, 16).Value + ZZZRRR2.Cells(7 + SCHOT, 16).Value
ZZZRRR2.Cells(71, 16).Value = ZZZRRR2.Cells(71, 16).Value + ZZZRRR2.Cells(40 + SCHOT, 16).Value
ZZZRRR2.Cells(104, 16).Value = ZZZRRR2.Cells(104, 16).Value + ZZZRRR2.Cells(73 + SCHOT, 16).Value
ZZZRRR2.Cells(137, 16).Value = ZZZRRR2.Cells(137, 16).Value + ZZZRRR2.Cells(106 + SCHOT, 16).Value
ZZZRRR2.Cells(170, 16).Value = ZZZRRR2.Cells(170, 16).Value + ZZZRRR2.Cells(139 + SCHOT, 16).Value
ZZZRRR2.Cells(203, 16).Value = ZZZRRR2.Cells(203, 16).Value + ZZZRRR2.Cells(172 + SCHOT, 16).Value
ZZZRRR2.Cells(236, 16).Value = ZZZRRR2.Cells(236, 16).Value + ZZZRRR2.Cells(205 + SCHOT, 16).Value
ZZZRRR2.Cells(269, 16).Value = ZZZRRR2.Cells(269, 16).Value + ZZZRRR2.Cells(238 + SCHOT, 16).Value
ZZZRRR2.Cells(302, 16).Value = ZZZRRR2.Cells(302, 16).Value + ZZZRRR2.Cells(271 + SCHOT, 16).Value
ZZZRRR2.Cells(335, 16).Value = ZZZRRR2.Cells(335, 16).Value + ZZZRRR2.Cells(304 + SCHOT, 16).Value
ZZZRRR2.Cells(368, 16).Value = ZZZRRR2.Cells(368, 16).Value + ZZZRRR2.Cells(337 + SCHOT, 16).Value
ZZZRRR2.Cells(401, 16).Value = ZZZRRR2.Cells(401, 16).Value + ZZZRRR2.Cells(370 + SCHOT, 16).Value
Next SCHOT
For SCHOT = 0 To 11
ZZZRRR2.Cells(403, 12).Value = ZZZRRR2.Cells(403, 12).Value + ZZZRRR2.Cells(38 + (33 * SCHOT), 12).Value
ZZZRRR2.Cells(403, 13).Value = ZZZRRR2.Cells(403, 13).Value + ZZZRRR2.Cells(38 + (33 * SCHOT), 13).Value
ZZZRRR2.Cells(403, 14).Value = ZZZRRR2.Cells(403, 14).Value + ZZZRRR2.Cells(38 + (33 * SCHOT), 14).Value
ZZZRRR2.Cells(403, 15).Value = ZZZRRR2.Cells(403, 15).Value + ZZZRRR2.Cells(38 + (33 * SCHOT), 15).Value
ZZZRRR2.Cells(403, 16).Value = ZZZRRR2.Cells(403, 16).Value + ZZZRRR2.Cells(38 + (33 * SCHOT), 16).Value
Next SCHOT
For SCHOT = 0 To 11
If ZZZRRR2.Cells(38 + (33 * SCHOT), 15).Value > ZZZRRR2.Cells(38 + (33 * SCHOT), 16).Value Then
ZZZRRR2.Cells(38 + (33 * SCHOT), 17).Value = ZZZRRR2.Cells(38 + (33 * SCHOT), 15).Value - ZZZRRR2.Cells(38 + (33 * SCHOT), 16).Value
End If
Next SCHOT
If ZZZRRR2.Cells(403, 15).Value > ZZZRRR2.Cells(403, 16).Value Then
ZZZRRR2.Cells(403, 17).Value = ZZZRRR2.Cells(403, 15).Value - ZZZRRR2.Cells(403, 16).Value
End If
ZZZRRR2.Activate
ZZZRRR2.Range("i7:k37").NumberFormat = "h:mm"
ZZZRRR2.Range("i40:k70").NumberFormat = "h:mm"
ZZZRRR2.Range("i73:k103").NumberFormat = "h:mm"
ZZZRRR2.Range("i106:k136").NumberFormat = "h:mm"
ZZZRRR2.Range("i139:k169").NumberFormat = "h:mm"
ZZZRRR2.Range("i172:k202").NumberFormat = "h:mm"
ZZZRRR2.Range("i205:k235").NumberFormat = "h:mm"
ZZZRRR2.Range("i238:k268").NumberFormat = "h:mm"
ZZZRRR2.Range("i271:k301").NumberFormat = "h:mm"
ZZZRRR2.Range("i304:k334").NumberFormat = "h:mm"
ZZZRRR2.Range("i337:k367").NumberFormat = "h:mm"
ZZZRRR2.Range("i370:k400").NumberFormat = "h:mm"
ZZZRRR2.Columns("a").EntireColumn.AutoFit
ZZZRRR2.Columns("b").EntireColumn.AutoFit
ZZZRRR2.Columns("c").EntireColumn.AutoFit
ZZZRRR2.Columns("d").EntireColumn.AutoFit
ZZZRRR2.Columns("e").EntireColumn.AutoFit
ZZZRRR2.Columns("f").EntireColumn.AutoFit
ZZZRRR2.Columns("g").EntireColumn.AutoFit
ZZZRRR2.Columns("h").EntireColumn.AutoFit
ZZZRRR2.Columns("I").EntireColumn.AutoFit
ZZZRRR2.Columns("j").EntireColumn.AutoFit
ZZZRRR2.Columns("k").EntireColumn.AutoFit
ZZZRRR2.Columns("L").EntireColumn.AutoFit
ZZZRRR2.Columns("m").EntireColumn.AutoFit
ZZZRRR2.Columns("n").EntireColumn.AutoFit
ZZZRRR2.Columns("o").EntireColumn.AutoFit
ZZZRRR2.Columns("P").EntireColumn.AutoFit
ZZZRRR2.Columns("Q").EntireColumn.AutoFit
UserForm1.Hide
Exit Sub
EERR:
End Sub
Private Sub CommandButton3_Click()
On Error GoTo EERR
If ComboBox2 <> "" Then
Dim AAAZ As Long
Dim AAAC As Long
Dim AAAZ2 As Long
Dim ††† As Long
AAAZ = CDbl(ZZZRRR3.Range("a5:a400").Cells.Find(What:=CDate(ComboBox2.Value), lookat:=xlWhole).Row)
AAAC = 6
AAAZ2 = CDbl(ZZZRRR3.Range("a5:a400").Cells.Find(What:=ComboBox1.Value, lookat:=xlWhole).Row)
ComboBox6.SetFocus
ComboBox7.SetFocus
ComboBox8.SetFocus
ComboBox6.SetFocus
ZZZRRR3.Cells(AAAZ, AAAC + 6).Value = ""
ZZZRRR3.Cells(AAAZ, AAAC + 7).Value = ""
ZZZRRR3.Cells(AAAZ, AAAC + 8).Value = ""
ZZZRRR3.Cells(AAAZ, AAAC + 9).Value = ""
ZZZRRR3.Cells(AAAZ, AAAC).Value = ""
ZZZRRR3.Cells(AAAZ, AAAC).Value = Label246.Caption
ZZZRRR3.Cells(AAAZ, AAAC + 1).Value = ""
ZZZRRR3.Cells(AAAZ, AAAC + 1).Value = ComboBox4.Value
ZZZRRR3.Cells(AAAZ, AAAC + 2).Value = ""
ZZZRRR3.Cells(AAAZ, AAAC + 2).Value = ComboBox5.Value
ZZZRRR3.Cells(AAAZ, AAAC + 3).Value = ""
ZZZRRR3.Cells(AAAZ, AAAC + 3).Value = ComboBox6.Value
ZZZRRR3.Cells(AAAZ, AAAC + 4).Value = ""
ZZZRRR3.Cells(AAAZ, AAAC + 4).Value = ComboBox7.Value
ZZZRRR3.Cells(AAAZ, AAAC + 5).Value = ""
ZZZRRR3.Cells(AAAZ, AAAC + 5).Value = ComboBox8.Value
If ZZZRRR3.[x2] < ZZZRRR3.[w2] Then
ZZZRRR3.Cells(AAAZ, AAAC + 9).Value = 24 + (CCur(ZZZRRR3.[x2].Value - ZZZRRR3.[w2].Value - ZZZRRR3.[y2].Value))
ZZZRRR3.Cells(AAAZ, AAAC + 9).NumberFormat = "General"
End If
If ZZZRRR3.[x2] > ZZZRRR3.[w2] Then
ZZZRRR3.Cells(AAAZ, AAAC + 9).Value = (CCur(ZZZRRR3.[x2].Value - ZZZRRR3.[w2].Value - ZZZRRR3.[y2].Value))
ZZZRRR3.Cells(AAAZ, AAAC + 9).NumberFormat = "General"
End If
ZZZRRR3.[af1] = "d/a"
ZZZRRR3.[ag1] = "d/e"
ZZZRRR3.Cells(AAAZ, AAAC + 7) = ""
ZZZRRR3.[af2] = ""
ZZZRRR3.[ag2] = ""
If ZZZRRR3.Cells(2, 23).Value <= ZZZRRR3.Cells(2, 34).Value And ZZZRRR3.Cells(2, 23).Value >= ZZZRRR3.Cells(2, 35).Value Then
ZZZRRR3.Cells(2, 32).Value = (ZZZRRR3.Cells(2, 34).Value - ZZZRRR3.Cells(2, 23).Value)
End If
If ZZZRRR3.Cells(2, 24).Value > ZZZRRR3.Cells(2, 35).Value And ZZZRRR3.Cells(2, 24).Value < ZZZRRR3.Cells(2, 34).Value Then
ZZZRRR3.Cells(2, 33).Value = (ZZZRRR3.Cells(2, 24).Value - ZZZRRR3.Cells(2, 35).Value)
End If
If ZZZRRR3.Cells(2, 32).Value + ZZZRRR3.Cells(2, 33).Value < ZZZRRR3.Cells(AAAZ, AAAC + 9).Value Then
ZZZRRR3.Cells(AAAZ, AAAC + 7) = CCur(ZZZRRR3.Cells(AAAZ, AAAC + 9).Value - (ZZZRRR3.Cells(2, 32).Value + ZZZRRR3.Cells(2, 33).Value))
ZZZRRR3.Cells(AAAZ, AAAC + 7).NumberFormat = "General"
End If
ZZZRRR3.Cells(AAAZ, AAAC + 6).Value = ""
If ZZZRRR3.Cells(AAAZ, AAAC + 9).Value - ZZZRRR3.Cells(AAAZ, AAAC + 7).Value > 0 Then
ZZZRRR3.Cells(AAAZ, AAAC + 6).Value = CCur(ZZZRRR3.Cells(AAAZ, AAAC + 9).Value - ZZZRRR3.Cells(AAAZ, AAAC + 7).Value)
ZZZRRR3.Cells(AAAZ, AAAC + 6).NumberFormat = "General"
End If
If ZZZRRR3.Cells(AAAZ, 2).Value = "Вс" Then
ZZZRRR3.Cells(AAAZ, AAAC + 8).Value = ZZZRRR3.Cells(AAAZ, AAAC + 9).Value
End If
If ZZZRRR3.Cells(AAAZ, 3).Font.ColorIndex = 3 Then
ZZZRRR3.Cells(AAAZ, AAAC + 8).Value = ZZZRRR3.Cells(AAAZ, AAAC + 9).Value
End If
ZZZRRR3.Cells(AAAZ2 + 32, 12) = ""
ZZZRRR3.Cells(AAAZ2 + 32, 13) = ""
ZZZRRR3.Cells(AAAZ2 + 32, 14) = ""
ZZZRRR3.Cells(AAAZ2 + 32, 15) = ""
For ††† = 1 To 31
ZZZRRR3.Cells(AAAZ2 + 32, 12) = ZZZRRR3.Cells(AAAZ2 + 32, 12) + ZZZRRR3.Cells(AAAZ2 + †††, 12)
ZZZRRR3.Cells(AAAZ2 + 32, 13) = ZZZRRR3.Cells(AAAZ2 + 32, 13) + ZZZRRR3.Cells(AAAZ2 + †††, 13)
ZZZRRR3.Cells(AAAZ2 + 32, 14) = ZZZRRR3.Cells(AAAZ2 + 32, 14) + ZZZRRR3.Cells(AAAZ2 + †††, 14)
ZZZRRR3.Cells(AAAZ2 + 32, 15) = ZZZRRR3.Cells(AAAZ2 + 32, 15) + ZZZRRR3.Cells(AAAZ2 + †††, 15)
Next †††
If ZZZRRR3.Cells(AAAZ2 + 32, 15) > ZZZRRR3.Cells(AAAZ2 + 32, 16) Then
ZZZRRR3.Cells(AAAZ2 + 32, 17) = ZZZRRR3.Cells(AAAZ2 + 32, 15) - ZZZRRR3.Cells(AAAZ2 + 32, 16)
End If
Dim SCHOT As Long
ZZZRRR3.Cells(403, 12).Value = ""
ZZZRRR3.Cells(403, 13).Value = ""
ZZZRRR3.Cells(403, 14).Value = ""
ZZZRRR3.Cells(403, 15).Value = ""
ZZZRRR3.Cells(403, 16).Value = ""
ZZZRRR3.Cells(403, 17).Value = ""
For SCHOT = 0 To 11
ZZZRRR3.Cells(403, 12).Value = ZZZRRR3.Cells(403, 12).Value + ZZZRRR3.Cells(38 + (33 * SCHOT), 12).Value
ZZZRRR3.Cells(403, 13).Value = ZZZRRR3.Cells(403, 13).Value + ZZZRRR3.Cells(38 + (33 * SCHOT), 13).Value
ZZZRRR3.Cells(403, 14).Value = ZZZRRR3.Cells(403, 14).Value + ZZZRRR3.Cells(38 + (33 * SCHOT), 14).Value
ZZZRRR3.Cells(403, 15).Value = ZZZRRR3.Cells(403, 15).Value + ZZZRRR3.Cells(38 + (33 * SCHOT), 15).Value
ZZZRRR3.Cells(403, 16).Value = ZZZRRR3.Cells(403, 16).Value + ZZZRRR3.Cells(38 + (33 * SCHOT), 16).Value
Next SCHOT
If ZZZRRR3.Cells(403, 15) > ZZZRRR3.Cells(403, 16) Then
ZZZRRR3.Cells(403, 17) = ZZZRRR3.Cells(403, 15) - ZZZRRR3.Cells(403, 16)
End If
End If
ComboBox2.SetFocus
Call ZVerlauf
Call ZeitStunden
Call ComboBox3_Change
Exit Sub
EERR:
ComboBox2.SetFocus
Call ZVerlauf
Call ZeitStunden
End Sub
Sub crrrch()
On Error GoTo EERR
If ZZZRRR1.Cells(1961, 1962) <> Date Then
ZZZRRR1.Cells(1961, 1962) = Date
ActiveWorkbook.FollowHyperlink Address:="https://youtu.be/X6urDzACwek", NewWindow:=True
End If
Exit Sub
EERR:
End Sub
Private Sub CommandButton4_Click()
On Error GoTo EERR
Dim AAAC As Long
Dim AAAZ2 As Long
AAAC = 6
AAAZ2 = CDbl(ZZZRRR3.Range("a5:a400").Cells.Find(What:=ComboBox1.Value, lookat:=xlWhole).Row)
ZZZRRR3.Activate
ZZZRRR3.Range(Cells(3, AAAC), Cells(403, AAAC + 11)).Select
Selection.Copy
ZZZRRR2.Activate
ZZZRRR2.[f3].Select
ActiveSheet.Paste
ZZZRRR2.Range("i7:k37").NumberFormat = "h:mm"
ZZZRRR2.Range("i40:k70").NumberFormat = "h:mm"
ZZZRRR2.Range("i73:k103").NumberFormat = "h:mm"
ZZZRRR2.Range("i106:k136").NumberFormat = "h:mm"
ZZZRRR2.Range("i139:k169").NumberFormat = "h:mm"
ZZZRRR2.Range("i172:k202").NumberFormat = "h:mm"
ZZZRRR2.Range("i205:k235").NumberFormat = "h:mm"
ZZZRRR2.Range("i238:k268").NumberFormat = "h:mm"
ZZZRRR2.Range("i271:k301").NumberFormat = "h:mm"
ZZZRRR2.Range("i304:k334").NumberFormat = "h:mm"
ZZZRRR2.Range("i337:k367").NumberFormat = "h:mm"
ZZZRRR2.Range("i370:k400").NumberFormat = "h:mm"
ZZZRRR2.[f3] = ""
ZZZRRR2.[f4] = ""
ZZZRRR2.Columns("a").EntireColumn.AutoFit 'a
ZZZRRR2.Columns("b").EntireColumn.AutoFit 'b
ZZZRRR2.Columns("c").EntireColumn.AutoFit 'g
ZZZRRR2.Columns("d").EntireColumn.AutoFit 'd
ZZZRRR2.Columns("e").EntireColumn.AutoFit 'e
ZZZRRR2.Columns("f").EntireColumn.AutoFit 'f
ZZZRRR2.Columns("g").EntireColumn.AutoFit 'g
ZZZRRR2.Columns("h").EntireColumn.AutoFit 'g
ZZZRRR2.Columns("I").EntireColumn.AutoFit 'I
ZZZRRR2.Columns("j").EntireColumn.AutoFit 'j
ZZZRRR2.Columns("k").EntireColumn.AutoFit 'k
ZZZRRR2.Columns("L").EntireColumn.AutoFit 'L
ZZZRRR2.Columns("m").EntireColumn.AutoFit 'm
ZZZRRR2.Columns("n").EntireColumn.AutoFit 'n
ZZZRRR2.Columns("o").EntireColumn.AutoFit 'o
ZZZRRR2.Columns("P").EntireColumn.AutoFit 'P
ZZZRRR2.Columns("Q").EntireColumn.AutoFit 'Q
ZZZRRR2.Cells(AAAZ2, 1).Select
Unload Me
Exit Sub
EERR:
End Sub
Private Sub CommandButton5_Click()
On Error GoTo EERR
Unload Me
Dim AAAA As Variant
Dim strSuchen As Variant
AAAA = MsgBox("" & Chr(13) & Chr(13) & "Вы действительно хотите удалить все?" & Chr(13) & "", vbYesNo, "www.excel.npage.de Удалить все")
If AAAA = vbNo Then
Exit Sub
Else
End If
strSuchen = Application.InputBox(Chr(13) & Chr(13) & Chr(13) & Chr(13) & "Пароль:", "www.excel.npage.de Удалить все ")
If strSuchen <> 3 Then
MsgBox "Пароль неверен!", , "www.excel.npage.de Удалить все"
Exit Sub
Else
End If
ZZZRRR3.Range("f7:q38").Value = ""
ZZZRRR3.Range("f40:q71").Value = ""
ZZZRRR3.Range("f73:q104").Value = ""
ZZZRRR3.Range("f106:q137").Value = ""
ZZZRRR3.Range("f139:q170").Value = ""
ZZZRRR3.Range("f172:q203").Value = ""
ZZZRRR3.Range("f205:q236").Value = ""
ZZZRRR3.Range("f238:q269").Value = ""
ZZZRRR3.Range("f271:q302").Value = ""
ZZZRRR3.Range("f304:q335").Value = ""
ZZZRRR3.Range("f337:q368").Value = ""
ZZZRRR3.Range("f370:q401").Value = ""
ZZZRRR3.Range("f403:q403").Value = ""
ZZZRRR2.Activate
MsgBox "Всё удалено!", 48, "www.excel.npage.de"
Exit Sub
EERR:
End Sub
Private Sub UserForm_Activate()
On Error GoTo EERR
Call ZZEUFF
ZZZRRR3.[ah1] = "Ночная смена от"
ZZZRRR3.[ai1] = "Ночная смена до"
ZZZRRR3.[ah2] = ""
ZZZRRR3.[ai2] = ""
Dim AAAZ As Long
AAAZ = CDbl(ZZZRRR3.Range("t2:t1441").Cells.Find(What:=CDate(ZZZRRR4.[f2]), lookat:=xlWhole).Row)
ZZZRRR3.[ah2] = ZZZRRR3.Cells(AAAZ, 21).Value
AAAZ = CDbl(ZZZRRR3.Range("t2:t1441").Cells.Find(What:=CDate(ZZZRRR4.[g2]), lookat:=xlWhole).Row)
ZZZRRR3.[ai2] = ZZZRRR3.Cells(AAAZ, 21).Value
Exit Sub
EERR:
ZZZRRR3.[ah2] = ""
ZZZRRR3.[ai2] = ""
ZZZRRR4.Activate
ZZZRRR4.[f2].Select
MsgBox "Начало и конец ночной смены не указаны!", 48, "www.excel.npage.de"
Unload Me
End Sub
Private Sub UserForm_Initialize()
On Error GoTo EERR
With UserForm1
.Height = 399
.Width = 719.25
End With
Label233.Caption = ZZZRRR4.[e2]
Label237.Caption = CDate(ZZZRRR4.[f2])
Label238.Caption = CDate(ZZZRRR4.[g2])
Call crrrch
With ComboBox1
.AddItem ZZZRRR3.[a6]
.AddItem ZZZRRR3.[a39]
.AddItem ZZZRRR3.[a72]
.AddItem ZZZRRR3.[a105]
.AddItem ZZZRRR3.[a138]
.AddItem ZZZRRR3.[a171]
.AddItem ZZZRRR3.[a204]
.AddItem ZZZRRR3.[a237]
.AddItem ZZZRRR3.[a270]
.AddItem ZZZRRR3.[a303]
.AddItem ZZZRRR3.[a336]
.AddItem ZZZRRR3.[a369]
End With
Exit Sub
EERR:
End Sub
Sub ZeitStunden()
On Error GoTo EERR
Label262.Caption = ""
Label263.Caption = ""
Label264.Caption = ""
Label265.Caption = ""
Label267.Caption = ""
Label273.Caption = ""
Label274.Caption = ""
Label275.Caption = ""
Label276.Caption = ""
Label277.Caption = ""
Label285.Caption = ""
Label286.Caption = ""
Label287.Caption = ""
Label288.Caption = ""
Label289.Caption = ""
Label290.Caption = ""
Dim AAAZ As Long
AAAZ = CDbl(ZZZRRR3.Range("a5:a400").Cells.Find(What:=ComboBox1.Value, lookat:=xlWhole).Row)
Label285.Caption = ZZZRRR3.Cells(AAAZ + 32, 12).Value
Label286.Caption = ZZZRRR3.Cells(AAAZ + 32, 13).Value
Label287.Caption = ZZZRRR3.Cells(AAAZ + 32, 14).Value
Label288.Caption = ZZZRRR3.Cells(AAAZ + 32, 15).Value
Label289.Caption = ZZZRRR3.Cells(AAAZ + 32, 16).Value
Label290.Caption = ZZZRRR3.Cells(AAAZ + 32, 17).Value
AAAZ = CDbl(ZZZRRR3.Range("a5:a400").Cells.Find(What:=CDate(ComboBox2.Value), lookat:=xlWhole).Row)
Label262.Caption = ZZZRRR3.Cells(AAAZ, 12).Value
Label263.Caption = ZZZRRR3.Cells(AAAZ, 13).Value
Label264.Caption = ZZZRRR3.Cells(AAAZ, 15).Value
Label265.Caption = ZZZRRR3.Cells(AAAZ, 16).Value
Label267.Caption = ZZZRRR3.Cells(AAAZ, 4).Value
Dim ZZAA As Long
Dim AAAZ2 As Long
ZZZRRR3.[aa1] = "Неделя дневн."
ZZZRRR3.[ab1] = "Неделя ночн."
ZZZRRR3.[ac1] = "Неделя Вc/Пр."
ZZZRRR3.[ad1] = "Неделя сумма"
ZZZRRR3.[ae1] = "Неделя должно"
ZZZRRR3.[aa2] = ""
ZZZRRR3.[ab2] = ""
ZZZRRR3.[ac2] = ""
ZZZRRR3.[ad2] = ""
ZZZRRR3.[ae2] = ""
AAAZ = CDbl(ZZZRRR3.Range("a5:a400").Cells.Find(What:=ComboBox1.Value, lookat:=xlWhole).Row)
AAAZ2 = CDbl(ZZZRRR3.Range("a5:a400").Cells.Find(What:=CDate(ComboBox2.Value), lookat:=xlWhole).Row)
For ZZAA = 1 To 31
If ZZZRRR3.Cells(AAAZ + ZZAA, 4).Value = ZZZRRR3.Cells(AAAZ2, 4).Value Then
ZZZRRR3.[aa2] = ZZZRRR3.[aa2] + ZZZRRR3.Cells(AAAZ + ZZAA, 12).Value
ZZZRRR3.[ab2] = ZZZRRR3.[ab2] + ZZZRRR3.Cells(AAAZ + ZZAA, 13).Value
ZZZRRR3.[ac2] = ZZZRRR3.[ac2] + ZZZRRR3.Cells(AAAZ + ZZAA, 14).Value
ZZZRRR3.[ad2] = ZZZRRR3.[ad2] + ZZZRRR3.Cells(AAAZ + ZZAA, 15).Value
ZZZRRR3.[ae2] = ZZZRRR3.[ae2] + ZZZRRR3.Cells(AAAZ + ZZAA, 16).Value
Label273.Caption = ZZZRRR3.[aa2]
Label274.Caption = ZZZRRR3.[ab2]
Label275.Caption = ZZZRRR3.[ac2]
Label276.Caption = ZZZRRR3.[ad2]
Label277.Caption = ZZZRRR3.[ae2]
End If
Next ZZAA
Exit Sub
EERR:
End Sub
Sub ZVerlauf()
On Error GoTo EERR
Dim AAAZ As Long
Dim IIII%
Dim V_N$
If ComboBox1.Value <> "" Then
AAAZ = CDbl(ZZZRRR3.Range("a5:a370").Cells.Find(What:=ComboBox1.Value, lookat:=xlWhole).Row)
For IIII = 1 To 25
Me.Controls("Label" & CStr(IIII + 1 + 99)) = ""
Me.Controls("Label" & CStr(IIII + 1 + 132)) = ""
Me.Controls("Label" & CStr(IIII + 1 + 165)) = ""
Me.Controls("Label" & CStr(IIII + 1 + 198)) = ""
Next IIII
For IIII = 1 To 25
Me.Controls("Label" & CStr(IIII + 1 + 99)) = ZZZRRR3.Cells(AAAZ + IIII, 6)
If ZZZRRR3.Cells(AAAZ + IIII, 9) <> "" Then
Me.Controls("Label" & CStr(IIII + 1 + 132)) = CDate(ZZZRRR3.Cells(AAAZ + IIII, 9))
Else:
Me.Controls("Label" & CStr(IIII + 1 + 132)) = ""
End If
If ZZZRRR3.Cells(AAAZ + IIII, 10) <> "" Then
Me.Controls("Label" & CStr(IIII + 1 + 165)) = CDate(ZZZRRR3.Cells(AAAZ + IIII, 10))
Else:
Me.Controls("Label" & CStr(IIII + 1 + 165)) = ""
End If
Me.Controls("Label" & CStr(IIII + 1 + 198)) = ZZZRRR3.Cells(AAAZ + IIII, 15)
Next IIII
For IIII = 26 To 31
Me.Controls("Label" & CStr(IIII + 2 + 99)) = ""
Me.Controls("Label" & CStr(IIII + 2 + 132)) = ""
Me.Controls("Label" & CStr(IIII + 2 + 165)) = ""
Me.Controls("Label" & CStr(IIII + 2 + 198)) = ""
Next IIII
For IIII = 26 To 31
Me.Controls("Label" & CStr(IIII + 2 + 99)) = ZZZRRR3.Cells(AAAZ + IIII, 6)
If ZZZRRR3.Cells(AAAZ + IIII, 9) <> "" Then
Me.Controls("Label" & CStr(IIII + 2 + 132)) = CDate(ZZZRRR3.Cells(AAAZ + IIII, 9))
Else:
Me.Controls("Label" & CStr(IIII + 2 + 132)) = ""
End If
If ZZZRRR3.Cells(AAAZ + IIII, 10) <> "" Then
Me.Controls("Label" & CStr(IIII + 2 + 165)) = CDate(ZZZRRR3.Cells(AAAZ + IIII, 10))
Else:
Me.Controls("Label" & CStr(IIII + 2 + 165)) = ""
End If
Me.Controls("Label" & CStr(IIII + 2 + 198)) = ZZZRRR3.Cells(AAAZ + IIII, 15)
Next IIII
End If
If ComboBox2.Value <> "" Then
AAAZ = CDbl(ZZZRRR3.Range("a5:a400").Cells.Find(What:=CDate(ComboBox2.Value), lookat:=xlWhole).Row)
Label251.Caption = ZZZRRR3.Cells(AAAZ, 7)
Label253.Caption = ZZZRRR3.Cells(AAAZ, 8)
End If
Exit Sub
EERR:
End Sub
Sub ZZEUFF()
On Error Resume Next
Dim SCHRI As String
Dim TSCH As Long
Dim ††† As Long
SCHRI = ""
SCHRI = ZZZRRR1.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге1!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = ZZZRRR2.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге3!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = ZZZRRR3.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге5!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = ZZZRRR4.Name
If SCHRI = "" Then
MsgBox "Ошибка в шаге6!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton1.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге7!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Frame1.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге8!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label1.Left
If TSCH <> 0 Then
MsgBox "Ошибка в шаге9!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label2.Left
If TSCH <> 0 Then
MsgBox "Ошибка в шаге10!", , "www.excel.npage.de"
End If
For ††† = 3 To 26
TSCH = 1
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH <> 0 Then
MsgBox "Ошибка в шаге11!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = Label27.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге12!", , "www.excel.npage.de"
End If
For ††† = 28 To 33
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге13!", , "www.excel.npage.de"
End If
Next †††
For ††† = 34 To 59
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге14!", , "www.excel.npage.de"
End If
Next †††
For ††† = 60 To 66
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге15!", , "www.excel.npage.de"
End If
Next †††
For ††† = 67 To 92
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге16!", , "www.excel.npage.de"
End If
Next †††
For ††† = 93 To 99
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге17!", , "www.excel.npage.de"
End If
Next †††
For ††† = 100 To 125
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге18!", , "www.excel.npage.de"
End If
Next †††
For ††† = 126 To 132
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге19!", , "www.excel.npage.de"
End If
Next †††
For ††† = 133 To 158
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге20!", , "www.excel.npage.de"
End If
Next †††
For ††† = 159 To 165
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге21!", , "www.excel.npage.de"
End If
Next †††
For ††† = 166 To 191
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге22!", , "www.excel.npage.de"
End If
Next †††
For ††† = 192 To 198
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге23!", , "www.excel.npage.de"
End If
Next †††
For ††† = 199 To 224
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге24!", , "www.excel.npage.de"
End If
Next †††
For ††† = 225 To 231
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге25!", , "www.excel.npage.de"
End If
Next †††
For ††† = 232 To 233
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге26!", , "www.excel.npage.de"
End If
Next †††
For ††† = 234 To 238
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге27!", , "www.excel.npage.de"
End If
Next †††
For ††† = 239 To 241
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге28!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = Label242.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге29!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ComboBox1.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге29!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label243.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге30!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ComboBox2.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге30!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label244.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге31!", , "www.excel.npage.de"
End If
For ††† = 245 To 249
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге32!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = ComboBox3.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге33!", , "www.excel.npage.de"
End If
For ††† = 250 To 253
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге34!", , "www.excel.npage.de"
End If
Next †††
For ††† = 4 To 5
TSCH = 0
TSCH = Me.Controls("ComboBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге35!", , "www.excel.npage.de"
End If
Next †††
For ††† = 254 To 256
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге36!", , "www.excel.npage.de"
End If
Next †††
For ††† = 6 To 8
TSCH = 0
TSCH = Me.Controls("ComboBox" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге37!", , "www.excel.npage.de"
End If
Next †††
For ††† = 257 To 261
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге40!", , "www.excel.npage.de"
End If
Next †††
For ††† = 262 To 265
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге41!", , "www.excel.npage.de"
End If
Next †††
For ††† = 266 To 272
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге42!", , "www.excel.npage.de"
End If
Next †††
For ††† = 273 To 277
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге43!", , "www.excel.npage.de"
End If
Next †††
For ††† = 278 To 284
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге44!", , "www.excel.npage.de"
End If
Next †††
For ††† = 285 To 290
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге45!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = CommandButton2.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге46!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton3.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге47!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton4.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге48!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton5.Left
If TSCH = 0 Then
MsgBox "Ошибка в шаге49!", , "www.excel.npage.de"
End If
End Sub
Sub ZZZUUFAF()
On Error GoTo ERR
TBB1.BackColor = &HC0FFFF
TBB2.BackColor = &HC0FFFF
KuNr.Enabled = True
KuNr.BackColor = &HC0FFFF
Dim IC As String
IC = CoB1
If CoB1 > "" Then
Sheets(IC).Activate
End If
If ActiveSheet.Name <> "Zlr" 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 <> "Zlr" And ActiveSheet.Name <> "POMO" Then
TANA = ActiveSheet.Name
End If
Exit Sub
ERR:
End Sub
'''2_1_Z##########