Create time recording program in Excel VBA yourself
List of manufacturing steps and code
0_Create time recording program in Excel VBA yourself_Thats how it works
1_Create time recording program in Excel VBA yourself_Workbook
2_Create time recording program in Excel VBA yourself_Create an input mask
3_Create time recording program in Excel VBA yourself_Sheet Calendar
4_Create time recording program in Excel VBA yourself_Sheet Calendar
5_Create time recording program in Excel VBA yourself_Sheet Form
6_Create time recording program in Excel VBA yourself_Sheet Legend
7_Create time recording program in Excel VBA yourself_CommandButton1
8_Create time recording program in Excel VBA yourself_Frame1
9_Create time recording program in Excel VBA yourself_Label1
10_Create time recording program in Excel VBA yourself_Label2
11_Create time recording program in Excel VBA yourself_Label3 - 26
12_Create time recording program in Excel VBA yourself_Label27
13_Create time recording program in Excel VBA yourself_Label28 - 33
14_Create time recording program in Excel VBA yourself_Label34 - 59
15_Create time recording program in Excel VBA yourself_Label60 - 66
16_Create time recording program in Excel VBA yourself_Label67 - 92
17_Create time recording program in Excel VBA yourself_Label93 - 99
18_Create time recording program in Excel VBA yourself_Label100 - 125
19_Create time recording program in Excel VBA yourself_Label126 - 132
20_Create time recording program in Excel VBA yourself_Label133 - 158
21_Create time recording program in Excel VBA yourself_Label159 - 165
22_Create time recording program in Excel VBA yourself_Label166 - 191
23_Create time recording program in Excel VBA yourself_Label192 - 198
24_Create time recording program in Excel VBA yourself_Label199 - 224
25_Create time recording program in Excel VBA yourself_Label225 - 231
26_Create time recording program in Excel VBA yourself_Label232 - 233
27_Create time recording program in Excel VBA yourself_Label234 – Label238
28_Create time recording program in Excel VBA yourself_Label239 – Label241
29_Create time recording program in Excel VBA yourself_Label242 and ComboBox1
30_Create time recording program in Excel VBA yourself_Label243 and ComboBox2
31_Create time recording program in Excel VBA yourself_Label244
32_Create time recording program in Excel VBA yourself_Label245 – Label249
33_Create time recording program in Excel VBA yourself_ComboBox3
34_Create time recording program in Excel VBA yourself_Label250 - Label253
35_Create time recording program in Excel VBA yourself_ComboBox4 - ComboBox5
36_Create time recording program in Excel VBA yourself_Label254 - Label256
37_Create time recording program in Excel VBA yourself_ComboBox6 - ComboBox8
38_Create time recording program in Excel VBA yourself_Time series
39_Create time recording program in Excel VBA yourself_Decimal number
40_Create time recording program in Excel VBA yourself_Label257 - Label261
41_Create time recording program in Excel VBA yourself_Label262 - Label265
42_Create time recording program in Excel VBA yourself_Label266 - Label272
43_Create time recording program in Excel VBA yourself_Label273 - Label277
44_Create time recording program in Excel VBA yourself_Label278 - Label284
45_Create time recording program in Excel VBA yourself_Label285 - Label290
46_Create time recording program in Excel VBA yourself_CommandButton2
47_Create time recording program in Excel VBA yourself_CommandButton3
48_Create time recording program in Excel VBA yourself_CommandButton4
49_Create time recording program in Excel VBA yourself_CommandButton5
50_Create time recording program in Excel VBA yourself_Hide worksheet
51_Create time recording program in Excel VBA yourself_Activation order in Frame1
52_Create time recording program in Excel VBA yourself_Enter code in Userform1
'''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) = "Sat" Then
Me.Controls("Label" & CStr(IIII + 1 + 33)).BackColor = &H80FF&
End If
If ZZZRRR3.Cells(AAAZ + IIII, 2) = "Sun" 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) = "Sat" Then
Me.Controls("Label" & CStr(IIII + 2 + 33)).BackColor = &H80FF&
End If
If ZZZRRR3.Cells(AAAZ + IIII, 2) = "Sun" 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) = "Sat" Then
ZZZRRR3.Cells(AAAZ + IIII, 16) = ""
End If
If ZZZRRR3.Cells(AAAZ + IIII, 2) = "Sun" 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 "Duration of the working day is not registered!", 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 = "Throughout the year__________ " & 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 = "Beginning of the year to date_________ " & 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 = "Date until end of year____ " & 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
Sub crrrch()
On Error GoTo EERR
If ZZZRRR1.Cells(1961, 1962) <> Date Then
ZZZRRR1.Cells(1961, 1962) = Date
ActiveWorkbook.FollowHyperlink Address:="https://youtu.be/XLHbz4NcMMY", NewWindow:=True
End If
Exit Sub
EERR:
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 "Time by was wrong!", 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 "Time up was wrong!", 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 "Time Break was wrong!", 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("Please enter a 4-digit year", "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 <> "Sat" And GGG3 <> "Sun" Then '
GGG3.Interior.ColorIndex = xlColorIndexNone
End If
Next GGG3
For Each GGG2 In ActiveSheet.Range("b7:b400")
If GGG2 = "Sun" Then
GGG2.Interior.ColorIndex = 3
End If
Next GGG2
For Each GGG4 In ActiveSheet.Range("b7:b400")
If GGG4 = "Sat" 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] = "New year's Eve"
ZZZRRR2.[c7].Font.ColorIndex = 3
ZZZRRR2.[c12] = "Epiphany"
ZZZRRR2.[c12].Font.ColorIndex = 1
ZZZRRR2.[c139] = "May day"
ZZZRRR2.[c139].Font.ColorIndex = 3
ZZZRRR2.[c252] = "Assumption of Mary"
ZZZRRR2.[c252].Font.ColorIndex = 1
ZZZRRR2.[c306] = "Day of German unity"
ZZZRRR2.[c306].Font.ColorIndex = 3
ZZZRRR2.[c334] = "Reformation day"
ZZZRRR2.[c334].Font.ColorIndex = 3
ZZZRRR2.[c337] = "All Saints' Day"
ZZZRRR2.[c337].Font.ColorIndex = 3
ZZZRRR2.[c393] = "Christmas Eve"
ZZZRRR2.[c393].Font.ColorIndex = 1
ZZZRRR2.[c394] = "Christmas day"
ZZZRRR2.[c394].Font.ColorIndex = 3
ZZZRRR2.[c395] = "Boxing Day"
ZZZRRR2.[c395].Font.ColorIndex = 3
Dim FFF As Object
For Each FFF In ZZZRRR2.Range("b353:b359")
If FFF = "Mi" Then
FFF.Offset(0, 1).Value = "Day of Prayer and Repentance"
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] = "Easter"
ZZZRRR2.[d65535] = "Easter Monday"
ZZZRRR2.[d65534] = "Good Friday"
ZZZRRR2.[d65533] = "Ascension of Christ"
ZZZRRR2.[d65532] = "Pentecost"
ZZZRRR2.[d65531] = "Whit Monday"
ZZZRRR2.[d65530] = "Corpus Christi"
ZZZRRR2.[d65529] = "Ash Wednesday"
ZZZRRR2.[d65528] = "Carnival Monday"
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 <> "Sat" And ZZZRRR2.Cells(IIII, 2).Value <> "Sun" 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 <> "Sat" And ZZZRRR2.Cells(IIII, 2).Value <> "Sun" 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 <> "Sat" And ZZZRRR2.Cells(IIII, 2).Value <> "Sun" 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 <> "Sat" And ZZZRRR2.Cells(IIII, 2).Value <> "Sun" 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 <> "Sat" And ZZZRRR2.Cells(IIII, 2).Value <> "Sun" 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 <> "Sat" And ZZZRRR2.Cells(IIII, 2).Value <> "Sun" 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 <> "Sat" And ZZZRRR2.Cells(IIII, 2).Value <> "Sun" 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 <> "Sat" And ZZZRRR2.Cells(IIII, 2).Value <> "Sun" 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 <> "Sat" And ZZZRRR2.Cells(IIII, 2).Value <> "Sun" 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 <> "Sat" And ZZZRRR2.Cells(IIII, 2).Value <> "Sun" 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 <> "Sat" And ZZZRRR2.Cells(IIII, 2).Value <> "Sun" 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 <> "Sat" And ZZZRRR2.Cells(IIII, 2).Value <> "Sun" 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 = "Sun" 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
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) & "Are you sure you want to delete everything?" & Chr(13) & "", vbYesNo, "www.excel.npage.de Delete everything")
If AAAA = vbNo Then
Exit Sub
Else
End If
strSuchen = Application.InputBox(Chr(13) & Chr(13) & Chr(13) & Chr(13) & "Password:", "www.excel.npage.de Delete everything ")
If strSuchen <> 3 Then
MsgBox "The password is incorrect!", , "www.excel.npage.de Delete everything"
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 "Everything is deleted", 48, "www.excel.npage.de"
Exit Sub
EERR:
End Sub
Private Sub UserForm_Activate()
On Error GoTo EERR
Call ZZEUFF
ZZZRRR3.[ah1] = "Night hours of"
ZZZRRR3.[ai1] = "Night hours until"
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 "Beginning and at the end of the night shift is not set!", 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] = "Week Normal"
ZZZRRR3.[ab1] = "Week Night"
ZZZRRR3.[ac1] = "Week S/h"
ZZZRRR3.[ad1] = "Week Total h"
ZZZRRR3.[ae1] = "Week Should"
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 "Error in step 1!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = ZZZRRR2.Name
If SCHRI = "" Then
MsgBox "Error in step 3!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = ZZZRRR3.Name
If SCHRI = "" Then
MsgBox "Error in step 5!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = ZZZRRR4.Name
If SCHRI = "" Then
MsgBox "Error in step 6!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton1.Left
If TSCH = 0 Then
MsgBox "Error in step 7!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Frame1.Left
If TSCH = 0 Then
MsgBox "Error in step 8!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label1.Left
If TSCH <> 0 Then
MsgBox "Error in step 9!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label2.Left
If TSCH <> 0 Then
MsgBox "Error in step 10!", , "www.excel.npage.de"
End If
For ††† = 3 To 26
TSCH = 1
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH <> 0 Then
MsgBox "Error in step 11!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = Label27.Left
If TSCH = 0 Then
MsgBox "Error in step 12!", , "www.excel.npage.de"
End If
For ††† = 28 To 33
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 28!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = Label242.Left
If TSCH = 0 Then
MsgBox "Error in step 29!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ComboBox1.Left
If TSCH = 0 Then
MsgBox "Error in step 29!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label243.Left
If TSCH = 0 Then
MsgBox "Error in step 30!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ComboBox2.Left
If TSCH = 0 Then
MsgBox "Error in step 30!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label244.Left
If TSCH = 0 Then
MsgBox "Error in step 31!", , "www.excel.npage.de"
End If
For ††† = 245 To 249
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Error in step 32!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = ComboBox3.Left
If TSCH = 0 Then
MsgBox "Error in step 33!", , "www.excel.npage.de"
End If
For ††† = 250 To 253
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 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 "Error in step 45!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = CommandButton2.Left
If TSCH = 0 Then
MsgBox "Error in step 46!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton3.Left
If TSCH = 0 Then
MsgBox "Error in step 47!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton4.Left
If TSCH = 0 Then
MsgBox "Error in step 48!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton5.Left
If TSCH = 0 Then
MsgBox "Error in step 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##########