Zeiterfassungsprogramm in Excel VBA selber erstellen
Liste von Herstellungsschritten und Code
0_Zeiterfassungsprogramm in Excel VBA selber erstellen_So funktioniert es
1_Zeiterfassungsprogramm in Excel VBA selber erstellen_Arbeitsmappe
2_Zeiterfassungsprogramm in Excel VBA selber erstellen_Eingabemaske erstellen
3_Zeiterfassungsprogramm in Excel VBA selber erstellen_Tabellenblatt Kalender
4_Zeiterfassungsprogramm in Excel VBA selber erstellen_Tabellenblatt Kalender
5_Zeiterfassungsprogramm in Excel VBA selber erstellen_Tabellenblatt Formular
6_Zeiterfassungsprogramm in Excel VBA selber erstellen_Tabellenblatt Legende
7_Zeiterfassungsprogramm in Excel VBA selber erstellen_CommandButton1
8_Zeiterfassungsprogramm in Excel VBA selber erstellen_Frame1
9_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label1
10_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label2
11_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label3 - 26
12_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label27
13_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label28 - 33
14_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label34 - 59
15_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label60 - 66
16_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label67 - 92
17_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label93 - 99
18_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label100 - 125
19_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label126 - 132
20_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label133 - 158
21_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label159 - 165
22_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label166 - 191
23_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label192 - 198
24_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label199 - 224
25_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label225 - 231
26_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label232 - 233
27_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label234 – Label238
28_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label239 – Label241
29_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label242 und ComboBox1
30_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label243 und ComboBox2
31_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label244
32_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label245 – Label249
33_Zeiterfassungsprogramm in Excel VBA selber erstellen_ComboBox3
34_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label250 - Label253
35_Zeiterfassungsprogramm in Excel VBA selber erstellen_ComboBox4 - ComboBox5
36_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label254 - Label256
37_Zeiterfassungsprogramm in Excel VBA selber erstellen_ComboBox6 - ComboBox8
38_Zeiterfassungsprogramm in Excel VBA selber erstellen_Uhrzeitreihe
39_Zeiterfassungsprogramm in Excel VBA selber erstellen_Dezimalzahl
40_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label257 - Label261
41_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label262 - Label265
42_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label266 - Label272
43_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label273 - Label277
44_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label278 - Label284
45_Zeiterfassungsprogramm in Excel VBA selber erstellen_Label285 - Label290
46_Zeiterfassungsprogramm in Excel VBA selber erstellen_CommandButton2
47_Zeiterfassungsprogramm in Excel VBA selber erstellen_CommandButton3
48_Zeiterfassungsprogramm in Excel VBA selber erstellen_CommandButton4
49_Zeiterfassungsprogramm in Excel VBA selber erstellen_CommandButton5
50_Zeiterfassungsprogramm in Excel VBA selber erstellen_Tabellenblatt ausblenden
51_Zeiterfassungsprogramm in Excel VBA selber erstellen_Aktivierungsreihenfolge im Frame1
52_Zeiterfassungsprogramm in Excel VBA selber erstellen_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) = "Sa" Then
Me.Controls("Label" & CStr(IIII + 1 + 33)).BackColor = &H80FF&
End If
If ZZZRRR3.Cells(AAAZ + IIII, 2) = "So" 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) = "Sa" Then
Me.Controls("Label" & CStr(IIII + 2 + 33)).BackColor = &H80FF&
End If
If ZZZRRR3.Cells(AAAZ + IIII, 2) = "So" 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) = "Sa" Then
ZZZRRR3.Cells(AAAZ + IIII, 16) = ""
End If
If ZZZRRR3.Cells(AAAZ + IIII, 2) = "So" 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 "Dauer des Arbeitstages ist nicht eingetragen!", 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 = "Jahresanfang 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 "Uhrzeit von war falsch!", 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 "Uhrzeit bis war falsch!", 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 "Uhrzeit Pause war falsch!", 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("Bitte geben Sie eine 4-stellige Jahreszahl ein", "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 <> "Sa" And GGG3 <> "So" Then '
GGG3.Interior.ColorIndex = xlColorIndexNone
End If
Next GGG3
For Each GGG2 In ActiveSheet.Range("b7:b400")
If GGG2 = "So" Then
GGG2.Interior.ColorIndex = 3
End If
Next GGG2
For Each GGG4 In ActiveSheet.Range("b7:b400")
If GGG4 = "Sa" 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] = "Neujahr"
ZZZRRR2.[c7].Font.ColorIndex = 3
ZZZRRR2.[c12] = "Heilige Drei Könige"
ZZZRRR2.[c12].Font.ColorIndex = 1
ZZZRRR2.[c139] = "Erster Mai"
ZZZRRR2.[c139].Font.ColorIndex = 3
ZZZRRR2.[c252] = "Mariä Himmelfahrt"
ZZZRRR2.[c252].Font.ColorIndex = 1
ZZZRRR2.[c306] = "Tag der Deutschen Einheit"
ZZZRRR2.[c306].Font.ColorIndex = 3
ZZZRRR2.[c334] = "Reformationstag"
ZZZRRR2.[c334].Font.ColorIndex = 3
ZZZRRR2.[c337] = "Allerheiligen"
ZZZRRR2.[c337].Font.ColorIndex = 3
ZZZRRR2.[c393] = "Heiligabend"
ZZZRRR2.[c393].Font.ColorIndex = 1
ZZZRRR2.[c394] = "1. Weihnachtstag"
ZZZRRR2.[c394].Font.ColorIndex = 3
ZZZRRR2.[c395] = "2. Weihnachtstag"
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 = "Buß- und Bettag"
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] = "Ostern"
ZZZRRR2.[d65535] = "Osternmontag"
ZZZRRR2.[d65534] = "Karfreitag"
ZZZRRR2.[d65533] = "Christi Himmelfahrt"
ZZZRRR2.[d65532] = "Pfingsten"
ZZZRRR2.[d65531] = "Pfingstmontag"
ZZZRRR2.[d65530] = "Fronleichnam"
ZZZRRR2.[d65529] = "Aschermittwoch"
ZZZRRR2.[d65528] = "Rosenmontag"
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 <> "Sa" And ZZZRRR2.Cells(IIII, 2).Value <> "So" 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 <> "Sa" And ZZZRRR2.Cells(IIII, 2).Value <> "So" 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 <> "Sa" And ZZZRRR2.Cells(IIII, 2).Value <> "So" 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 <> "Sa" And ZZZRRR2.Cells(IIII, 2).Value <> "So" 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 <> "Sa" And ZZZRRR2.Cells(IIII, 2).Value <> "So" 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 <> "Sa" And ZZZRRR2.Cells(IIII, 2).Value <> "So" 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 <> "Sa" And ZZZRRR2.Cells(IIII, 2).Value <> "So" 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 <> "Sa" And ZZZRRR2.Cells(IIII, 2).Value <> "So" 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 <> "Sa" And ZZZRRR2.Cells(IIII, 2).Value <> "So" 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 <> "Sa" And ZZZRRR2.Cells(IIII, 2).Value <> "So" 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 <> "Sa" And ZZZRRR2.Cells(IIII, 2).Value <> "So" 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 <> "Sa" And ZZZRRR2.Cells(IIII, 2).Value <> "So" 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 = "So" 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/tO4beEUwcWo", 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) & "Moechten Sie wirklich alles loeschen?" & Chr(13) & "", vbYesNo, "www.excel.npage.de Alles loeschen")
If AAAA = vbNo Then
Exit Sub
Else
End If
strSuchen = Application.InputBox(Chr(13) & Chr(13) & Chr(13) & Chr(13) & "Kennwort:", "www.excel.npage.de Alles loeschen ")
If strSuchen <> 3 Then
MsgBox "Das Kennwort ist falsch", , "www.excel.npage.de Alles loeschen"
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 "Alles ist geloescht", 48, "www.excel.npage.de"
Exit Sub
EERR:
End Sub
Private Sub UserForm_Activate()
On Error GoTo EERR
Call ZZEUFF
ZZZRRR3.[ah1] = "Nachtstunden von"
ZZZRRR3.[ai1] = "Nachtstunden bis"
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 "Anfang und Ende der Nachtschicht nicht festgelegt!", 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] = "KW Normal"
ZZZRRR3.[ab1] = "KW Nacht"
ZZZRRR3.[ac1] = "KW S/F"
ZZZRRR3.[ad1] = "KW Gesamt"
ZZZRRR3.[ae1] = "KW Soll"
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 "Fehler im Schritt 1!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = ZZZRRR2.Name
If SCHRI = "" Then
MsgBox "Fehler im Schritt 3!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = ZZZRRR3.Name
If SCHRI = "" Then
MsgBox "Fehler im Schritt 5!", , "www.excel.npage.de"
End If
SCHRI = ""
SCHRI = ZZZRRR4.Name
If SCHRI = "" Then
MsgBox "Fehler im Schritt 6!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton1.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 7!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Frame1.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 8!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label1.Left
If TSCH <> 0 Then
MsgBox "Fehler im Schritt 9!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label2.Left
If TSCH <> 0 Then
MsgBox "Fehler im Schritt 10!", , "www.excel.npage.de"
End If
For ††† = 3 To 26
TSCH = 1
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH <> 0 Then
MsgBox "Fehler im Schritt 11!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = Label27.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 12!", , "www.excel.npage.de"
End If
For ††† = 28 To 33
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 28!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = Label242.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 29!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ComboBox1.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 29!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label243.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 30!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = ComboBox2.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 30!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = Label244.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 31!", , "www.excel.npage.de"
End If
For ††† = 245 To 249
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 32!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = ComboBox3.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 33!", , "www.excel.npage.de"
End If
For ††† = 250 To 253
TSCH = 0
TSCH = Me.Controls("Label" & CStr(†††)).Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 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 "Fehler im Schritt 45!", , "www.excel.npage.de"
End If
Next †††
TSCH = 0
TSCH = CommandButton2.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 46!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton3.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 47!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton4.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 48!", , "www.excel.npage.de"
End If
TSCH = 0
TSCH = CommandButton5.Left
If TSCH = 0 Then
MsgBox "Fehler im Schritt 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##########