Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1384to1388
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA-Prozedur zu groß

VBA-Prozedur zu groß
08.10.2014 12:08:51
Nicolai
Hallo zusammen,
ich habe gerade mein Marko erweitert und dann kamm die Fehlermeldung das die Prozedur zu groß ist.
Ich habe es bereits mit Call Prozedur1... versucht. es hat zwar den Code durchlaufen lassen, allerdings hat er ihn nicht ausgeführt.
Hier der Code:

Private Sub CommandButton1_Click()
Dim index As Long
Dim Mitarbeiter
Dim Tage As Integer
Dim dat As Date
Dim datmon As String
Dim Zeile, spalte As Integer
Set d2 = UserForm2
'Ermitteln des Abwesenheitsgrundes
If d2.OptionButton1.Value = True Then
akennz = 1 'Arbeitsvorbereitung
ElseIf d2.OptionButton2.Value = True Then
akennz = 2 'Besprechung
ElseIf d2.OptionButton3.Value = True Then
akennz = 3 'Einarbeitung
ElseIf d2.OptionButton4.Value = True Then
akennz = 4 'Schulung
ElseIf d2.OptionButton5.Value = True Then
akennz = 5 'KVP
ElseIf d2.OptionButton6.Value = True Then
akennz = 6 'Erste Hilfe
ElseIf d2.OptionButton7.Value = True Then
akennz = 7 'EBA
ElseIf d2.OptionButton8.Value = True Then
akennz = 8 'QS
ElseIf d2.OptionButton9.Value = True Then
akennz = 9 'BR
ElseIf d2.OptionButton10.Value = True Then
akennz = 10 'Anlagenausfall
ElseIf d2.OptionButton11.Value = True Then
akennz = 11 'Springer
ElseIf d2.OptionButton12.Value = True Then
akennz = 12 'Sonstiges
ElseIf d2.OptionButton13.Value = True Then
akennz = 13 'ZE
ElseIf d2.OptionButton14.Value = True Then
akennz = 14 'Ebenenwechsel
ElseIf d2.OptionButton15.Value = True Then
akennz = 15 'Zusatzpower
ElseIf d2.OptionButton16.Value = True Then
akennz = 16 'FreiW Mehrarbeit TZ
ElseIf d2.OptionButton17.Value = True Then
akennz = 17 'krank nach Hause
ElseIf d2.OptionButton18.Value = True Then
akennz = 18 'Fähigkeitenwerkstatt
' If d2.OptionButton19.Value = True Then akennz = 19 'Mini-CttC
ElseIf d2.OptionButton20.Value = True Then
akennz = 20 'ProFit
ElseIf d2.OptionButton21.Value = True Then
akennz = 21 'FreiW Mehrarbeit nach Schicht
ElseIf d2.OptionButton22.Value = True Then
akennz = 22 'FreiW Mehrarbeit vor Schicht
ElseIf d2.OptionButton23.Value = True Then
akennz = 23 'Kal.Mehrarbeit nach Schicht
ElseIf d2.OptionButton24.Value = True Then
akennz = 24 'Kal.Mehrarbeit vor Schicht
ElseIf d2.OptionButton25.Value = True Then
akennz = 25 'KalMehrarbeit TZ
ElseIf d2.OptionButton26.Value = True Then
akennz = 26 'Ang. Mehrarbeit nach Schicht
ElseIf d2.OptionButton27.Value = True Then
akennz = 27 'Ang. Mehrarbeit vor Schicht
ElseIf d2.OptionButton28.Value = True Then
akennz = 28 'Ang.Mehrarbeit TZ
ElseIf d2.OptionButton29.Value = True Then
akennz = 29 'Info Kommentar
Else
MsgBox ("Bitte Grund für Eintragung auswählen")
Exit Sub
End If
Dim AktZeile As Integer
Dim AktSpalte As Integer
AktZeile = ActiveCell.Row
AktSpalte = ActiveCell.Column
If IsNumeric(ActiveCell.Value) = False Then
MsgBox ("Falsche Zelle - abbrechen")
Exit Sub
End If
'Info Kommentar
If akennz = 29 And TextBox2.Value = "" Then
Dim wert1_29 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
Dim wert2_29 As Double
wert1_29 = ActiveCell.Value
'wert2_29 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
ElseIf akennz = 29 And Not (TextBox2.Value = "") Then
MsgBox ("ungültiger Wert2")
Exit Sub
ElseIf IsNumeric(TextBox2.Value) = False Or TextBox2.Value  50 Then
MsgBox ("ungültiger Wert")
Exit Sub
End If
'Arbeitsvorbereitung
If akennz = 1 Then
Dim wert1_1 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5!
Dim wert2_1 As Double
Dim com As Comment
wert1_1 = ActiveCell.Value
wert2_1 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_1 & " Stunde(n) Arbeitsvorbereitung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_1 & " Stunde(n) Arbeitsvorbereitung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_1  10 Then
Cells(331, ActiveCell.Column) = Cells(331, ActiveCell.Column) + wert2_1
'          ElseIf wert1_1 > 0 Then
'                Cells(475, ActiveCell.Column) = Cells(475, ActiveCell.Column) + wert2_1
'          Else
'                Cells(495, ActiveCell.Column) = Cells(495, ActiveCell.Column) + wert2_1
'          End If
End If
'Besprechung
If akennz = 2 Then
Dim wert1_2 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _
Dim wert2_2 As Double
wert1_2 = ActiveCell.Value
wert2_2 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_2 & " Stunde(n) Besprechung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_2 & " Stunde(n) Besprechung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_2  10 Then
Cells(332, ActiveCell.Column) = Cells(332, ActiveCell.Column) + wert2_2
'          ElseIf wert1_2 > 0 Then
'                Cells(476, ActiveCell.Column) = Cells(476, ActiveCell.Column) + wert2_2
'          Else
'                Cells(496, ActiveCell.Column) = Cells(496, ActiveCell.Column) + wert2_2
'          End If
End If
'Einarbeitung
If akennz = 3 Then
Dim wert1_3 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _
Dim wert2_3 As Double
wert1_3 = ActiveCell.Value
wert2_3 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_3 & " Stunde(n) Einarbeitung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_3 & " Stunde(n) Einarbeitung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_3  10 Then
Cells(333, ActiveCell.Column) = Cells(333, ActiveCell.Column) + wert2_3
'          ElseIf wert1_3 > 0 Then
'                Cells(477, ActiveCell.Column) = Cells(477, ActiveCell.Column) + wert2_3
'          Else
'                Cells(497, ActiveCell.Column) = Cells(497, ActiveCell.Column) + wert2_3
'          End If
End If
'Schulung
If akennz = 4 Then
Dim wert1_4 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _
Dim wert2_4 As Double
wert1_4 = ActiveCell.Value
wert2_4 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_4 & " Stunde(n) Schulung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & Format(Date, "DD. _
MM.") & " - " & Application.UserName & ": " & wert2_4 & " Stunde(n) Schulung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_4  10 Then
Cells(334, ActiveCell.Column) = Cells(334, ActiveCell.Column) + wert2_4
'        ElseIf wert1_4 > 0 Then
'                Cells(478, ActiveCell.Column) = Cells(478, ActiveCell.Column) + wert2_4
'          Else
'                Cells(498, ActiveCell.Column) = Cells(498, ActiveCell.Column) + wert2_4
'          End If
End If
'EO
If akennz = 5 Then
Dim wert1_5 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _
Dim wert2_5 As Double
wert1_5 = ActiveCell.Value
wert2_5 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_5 & " Stunde(n) EO " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & Format(Date, "DD. _
MM.") & " - " & Application.UserName & ": " & wert2_5 & " Stunde(n) EO " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_5  10 Then
Cells(335, ActiveCell.Column) = Cells(335, ActiveCell.Column) + wert2_6
'          ElseIf wert1_6 > 0 Then
'                Cells(479, ActiveCell.Column) = Cells(479, ActiveCell.Column) + wert2_6
'          Else
'                Cells(499, ActiveCell.Column) = Cells(499, ActiveCell.Column) + wert2_6
'          End If
End If
'EBA
If akennz = 7 Then
Dim wert1_7 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _
Dim wert2_7 As Double
wert1_7 = ActiveCell.Value
wert2_7 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_7 & " Stunde(n) EBA " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_7 & " Stunde(n) EBA " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_7  10 Then
Cells(336, ActiveCell.Column) = Cells(336, ActiveCell.Column) + wert2_7
'          ElseIf wert1_7 > 0 Then
'                Cells(480, ActiveCell.Column) = Cells(480, ActiveCell.Column) + wert2_7
'          Else
'                Cells(500, ActiveCell.Column) = Cells(500, ActiveCell.Column) + wert2_7
'          End If
End If
'QS
If akennz = 8 Then
Dim wert1_8 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _
Dim wert2_8 As Double
wert1_8 = ActiveCell.Value
wert2_8 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_8 & " Stunde(n) QS " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_8 & " Stunde(n) QS " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_8  10 Then
Cells(337, ActiveCell.Column) = Cells(337, ActiveCell.Column) + wert2_8
'          ElseIf wert1_8 > 0 Then
'                Cells(481, ActiveCell.Column) = Cells(481, ActiveCell.Column) + wert2_8
'          Else
'                Cells(501, ActiveCell.Column) = Cells(501, ActiveCell.Column) + wert2_8
'          End If
End If
'BR
If akennz = 9 Then
Dim wert1_9 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1,5! _
Dim wert2_9 As Double
wert1_9 = ActiveCell.Value
wert2_9 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_9 & " Stunde(n) BR " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_9 & " Stunde(n) BR " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_9  10 Then
Cells(338, ActiveCell.Column) = Cells(338, ActiveCell.Column) + wert2_9
'          ElseIf wert1_9 > 0 Then
'                Cells(482, ActiveCell.Column) = Cells(482, ActiveCell.Column) + wert2_9
'          Else
'                Cells(502, ActiveCell.Column) = Cells(502, ActiveCell.Column) + wert2_9
'          End If
End If
'Anlagenausfall
If akennz = 10 Then
Dim wert1_10 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
Dim wert2_10 As Double
wert1_10 = ActiveCell.Value
wert2_10 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_10 & " Stunde(n) Anlagenausfall " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_10 & " Stunde(n) Anlagenausfall " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_10  10 Then
Cells(339, ActiveCell.Column) = Cells(339, ActiveCell.Column) + wert2_10
'          ElseIf wert1_10 > 0 Then
'                Cells(483, ActiveCell.Column) = Cells(483, ActiveCell.Column) + wert2_10
'          Else
'                Cells(503, ActiveCell.Column) = Cells(503, ActiveCell.Column) + wert2_10
'          End If
End If
'Springer
If akennz = 11 Then
Dim wert1_11 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
Dim wert2_11 As Double
wert1_11 = ActiveCell.Value
wert2_11 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_11 & " Stunde(n) Springer " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_11 & " Stunde(n) Springer " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_11  10 Then
Cells(340, ActiveCell.Column) = Cells(340, ActiveCell.Column) + wert2_11
'          ElseIf wert1_11 > 0 Then
'                Cells(484, ActiveCell.Column) = Cells(484, ActiveCell.Column) + wert2_11
'          Else
'                Cells(504, ActiveCell.Column) = Cells(504, ActiveCell.Column) + wert2_11
'          End If
End If
'Sonstiges
If akennz = 12 Then
Dim wert1_12 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
Dim wert2_12 As Double
wert1_12 = ActiveCell.Value
wert2_12 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_12 & " Stunde(n) Sonstiges " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_12 & " Stunde(n) Sonstiges " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_12  10 Then
Cells(341, ActiveCell.Column) = Cells(341, ActiveCell.Column) + wert2_12
'          ElseIf wert1_12 > 0 Then
'                Cells(485, ActiveCell.Column) = Cells(485, ActiveCell.Column) + wert2_12
'          Else
'                Cells(505, ActiveCell.Column) = Cells(505, ActiveCell.Column) + wert2_12
'          End If
End If
'ZE
If akennz = 13 Then
Dim wert1_13 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
Dim wert2_13 As Double
wert1_13 = ActiveCell.Value
wert2_13 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_13 & " Stunde(n) ZE " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_13 & " Stunde(n) ZE " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_13  10 Then
Cells(342, ActiveCell.Column) = Cells(342, ActiveCell.Column) + wert2_13
'          ElseIf wert1_13 > 0 Then
'                Cells(486, ActiveCell.Column) = Cells(486, ActiveCell.Column) + wert2_13
'          Else
'                Cells(506, ActiveCell.Column) = Cells(506, ActiveCell.Column) + wert2_13
'          End If
End If
'Ebenenwechsel
If akennz = 14 Then
Dim wert1_14 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
Dim wert2_14 As Double
wert1_14 = ActiveCell.Value
wert2_14 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_14 & " Stunde(n) Ebenenwechsel " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_14 & " Stunde(n) Ebenenwechsel " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_14  10 Then
Cells(343, ActiveCell.Column) = Cells(343, ActiveCell.Column) + wert2_14
'          ElseIf wert1_14 > 0 Then
'                Cells(487, ActiveCell.Column) = Cells(487, ActiveCell.Column) + wert2_14
'          Else
'                Cells(507, ActiveCell.Column) = Cells(507, ActiveCell.Column) + wert2_14
'          End If
End If
'Zusatzpower gesamt
If akennz = 15 Then
Dim wert1_15 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
Dim wert2_15 As Double
wert1_15 = ActiveCell.Value
wert2_15 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveCell.Comment Is Nothing Then
With ActiveCell.AddComment
.Shape.TextFrame.AutoSize = True
.Text " | " & Format(Date, "DD.MM.") & " - " & Application.UserName & ": " & _
wert2_15 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = ActiveCell.Comment.Text
ActiveCell.Comment.Delete
With ActiveCell.AddComment
.Text vorhandener_Kommentar & " | " & Format(Date, "DD.MM.") & " - " &  _
Application.UserName & ": " & wert2_15 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_15  1000 Then
Cells(344, ActiveCell.Column) = Cells(344, ActiveCell.Column) + wert2_15
'          ElseIf wert1_15 > 0 Then
'                Cells(488, ActiveCell.Column) = Cells(488, ActiveCell.Column) + wert2_15
'          Else
'                Cells(508, ActiveCell.Column) = Cells(508, ActiveCell.Column) + wert2_15
'          End If
End If
'Freiwillige Mehrarbeit TZ
If akennz = 16 Then
Dim wert1_16 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
Dim wert2_16 As Double
Dim schließen As Boolean
wert1_16 = ActiveCell.Value
wert2_16 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Abfrage ob MA TZ ist
If AktZeile >= 20 And AktZeile  10 Then
Cells(345, ActiveCell.Column) = Cells(345, ActiveCell.Column) + wert2_17
'          ElseIf wert1_17 > 0 Then
'                Cells(490, ActiveCell.Column) = Cells(490, ActiveCell.Column) + wert2_17
'          Else
'                Cells(510, ActiveCell.Column) = Cells(510, ActiveCell.Column) + wert2_17
'          End If
End If
'Fähigkeitenwerkstatt
If akennz = 18 Then
Dim wert1_18 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
Dim wert2_18 As Double
wert1_18 = ActiveCell.Value
wert2_18 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_18 & " Stunde(n) Fähigkeitenwerkstatt " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_18 & " Stunde(n) Fähigkeitenwerkstatt " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
If wert1_18  10 Then
Cells(346, ActiveCell.Column) = Cells(346, ActiveCell.Column) + wert2_18
'          ElseIf wert1_18 > 0 Then
'                Cells(492, ActiveCell.Column) = Cells(492, ActiveCell.Column) + wert2_18
'          Else
'                Cells(512, ActiveCell.Column) = Cells(512, ActiveCell.Column) + wert2_18
'          End If
End If
'Mini-CttC
'  If akennz = 19 Then
'          Dim wert1_19 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
'          Dim wert2_19 As Double
'          wert1_19 = ActiveCell.Value
'          wert2_19 = UserForm2.TextBox2.Value
'          Kommentartext = UserForm2.TextBox3.Value
'          'Kommentar hinzufügen
'          If ActiveCell.Comment Is Nothing Then
'                With ActiveCell.AddComment
'                    .Shape.TextFrame.AutoSize = True
'                    .Text wert2_19 & " Stunde(n) Mini-CttC" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
'                End With
'          Else
'            vorhandener_Kommentar = ActiveCell.Comment.Text
'            ActiveCell.Comment.Delete
'                With ActiveCell.AddComment
'                    .Text vorhandener_Kommentar & wert2_19 & " Stunde(n) Mini-CttC" & Chr(10) & _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
'                    .Shape.TextFrame.AutoSize = True
'                End With
'        End If
'          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
'          If wert1_19  10 Then
'                Cells(531, ActiveCell.Column) = Cells(531, ActiveCell.Column) + wert2_19
'          ElseIf wert1_19 > 0 Then
'                Cells(491, ActiveCell.Column) = Cells(491, ActiveCell.Column) + wert2_19
'          Else
'                Cells(511, ActiveCell.Column) = Cells(511, ActiveCell.Column) + wert2_19
'          End If
'  End If
'     'Info Kommentar
'  If akennz = 29 Then
'          Dim wert1_29 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
'          Dim wert2_29 As Double
'          wert1_29 = ActiveCell.Value
'          wert2_29 = UserForm2.TextBox2.Value
'          Kommentartext = UserForm2.TextBox3.Value
'        'Kommentar hinzufügen
'        If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
'                     Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & "  _
- " & Application.UserName & ": " & wert2_29 & " Stunde(n) Besprechung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
'          Else
'            vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
'            Cells(AktZeile + 1, AktSpalte).Value = ""
'                Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_29 & " Stunde(n) Besprechung " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
'        End If
'          'Fallunterscheidung für negative Stundenanzahl / Schichtunterscheidung, z.B. -7,5
'          If wert1_29  10 Then
Cells(347, ActiveCell.Column) = Cells(347, ActiveCell.Column) + wert2_20
'          ElseIf wert1_20 > 0 Then
'                Cells(493, ActiveCell.Column) = Cells(493, ActiveCell.Column) + wert2_20
'          Else
'                Cells(513, ActiveCell.Column) = Cells(513, ActiveCell.Column) + wert2_20
'          End If
End If
'=============================================================================================== _
'Freiwillige Mehrarbeit nach Schicht
If akennz = 21 Then
Dim wert1_21 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
Dim wert2_21 As Double
wert1_21 = ActiveCell.Value
wert2_21 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_21 & " Stunde(n) FreiW-Mehrarbeit nach Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_21 & " Stunde(n) FreiW-Mehrarbeit nach Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Eintrag der Stunden in Zusatzpower
Dim number As Integer
number = ActiveCell
Select Case number
Case 10 To 20
Cells(442, ActiveCell.Column) = Cells(442, ActiveCell.Column) + wert2_21
If Cells(442, ActiveCell.Column).Comment Is Nothing Then
With Cells(442, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(442, ActiveCell.Column).Comment.Text
Cells(442, ActiveCell.Column).Comment.Delete
With Cells(442, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 110 To 120
Cells(441, ActiveCell.Column) = Cells(441, ActiveCell.Column) - wert2_21
If Cells(441, ActiveCell.Column).Comment Is Nothing Then
With Cells(441, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(441, ActiveCell.Column).Comment.Text
Cells(441, ActiveCell.Column).Comment.Delete
With Cells(441, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case -20 To -10
Cells(443, ActiveCell.Column + 1) = Cells(443, ActiveCell.Column + 1) +  _
wert2_21
If Cells(443, ActiveCell.Column + 1).Comment Is Nothing Then
With Cells(443, ActiveCell.Column + 1).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(443, ActiveCell.Column + 1).Comment.Text
Cells(443, ActiveCell.Column + 1).Comment.Delete
With Cells(443, ActiveCell.Column + 1).AddComment
.Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 30 To 40
Cells(445, ActiveCell.Column) = Cells(445, ActiveCell.Column) + wert2_21
If Cells(445, ActiveCell.Column).Comment Is Nothing Then
With Cells(445, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(445, ActiveCell.Column).Comment.Text
Cells(445, ActiveCell.Column).Comment.Delete
With Cells(445, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 130 To 140
Cells(444, ActiveCell.Column) = Cells(444, ActiveCell.Column) - wert2_21
If Cells(444, ActiveCell.Column).Comment Is Nothing Then
With Cells(444, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & _
Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(444, ActiveCell.Column).Comment.Text
Cells(444, ActiveCell.Column).Comment.Delete
With Cells(444, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case -40 To -30
Cells(446, ActiveCell.Column + 1) = Cells(446, ActiveCell.Column + 1) +  _
wert2_21
If Cells(446, ActiveCell.Column + 1).Comment Is Nothing Then
With Cells(446, ActiveCell.Column + 1).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(446, ActiveCell.Column + 1).Comment.Text
Cells(446, ActiveCell.Column + 1).Comment.Delete
With Cells(446, ActiveCell.Column + 1).AddComment
.Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 50 To 60
Cells(448, ActiveCell.Column) = Cells(448, ActiveCell.Column) + wert2_21
If Cells(448, ActiveCell.Column).Comment Is Nothing Then
With Cells(448, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(448, ActiveCell.Column).Comment.Text
Cells(448, ActiveCell.Column).Comment.Delete
With Cells(448, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 150 To 160
Cells(447, ActiveCell.Column) = Cells(447, ActiveCell.Column) - wert2_21
If Cells(447, ActiveCell.Column).Comment Is Nothing Then
With Cells(447, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & _
Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(447, ActiveCell.Column).Comment.Text
Cells(447, ActiveCell.Column).Comment.Delete
With Cells(447, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case -60 To -50
Cells(449, ActiveCell.Column + 1) = Cells(449, ActiveCell.Column + 1) +  _
wert2_21
If Cells(449, ActiveCell.Column + 1).Comment Is Nothing Then
With Cells(449, ActiveCell.Column + 1).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_21 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(449, ActiveCell.Column + 1).Comment.Text
Cells(449, ActiveCell.Column + 1).Comment.Delete
With Cells(449, ActiveCell.Column + 1).AddComment
.Text vorhandener_Kommentar & wert2_21 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
End Select
End If
'Freiwillige Mehrarbeit vor Schicht
If akennz = 22 Then
Dim wert1_22 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
Dim wert2_22 As Double
wert1_22 = ActiveCell.Value
wert2_22 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_22 & " Stunde(n) FreiW-Mehrarbeit vor Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_22 & " Stunde(n) FreiW-Mehrarbeit vor Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Eintrag der Stunden in Zusatzpower
Dim numbere As Integer
numbere = ActiveCell
Select Case numbere
Case 10 To 20
Cells(443, ActiveCell.Column) = Cells(443, ActiveCell.Column) +  _
wert2_22
If Cells(443, ActiveCell.Column).Comment Is Nothing Then
With Cells(443, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(443, ActiveCell.Column).Comment. _
Text
Cells(443, ActiveCell.Column).Comment.Delete
With Cells(443, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 110 To 120
Cells(442, ActiveCell.Column - 1) = Cells(442, ActiveCell.Column - 1) -  _
wert2_22
If Cells(442, ActiveCell.Column - 1).Comment Is Nothing Then
With Cells(442, ActiveCell.Column - 1).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(442, ActiveCell.Column - 1).Comment. _
Text
Cells(442, ActiveCell.Column - 1).Comment.Delete
With Cells(442, ActiveCell.Column - 1).AddComment
.Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case -20 To -10
Cells(441, ActiveCell.Column) = Cells(441, ActiveCell.Column) + wert2_22
If Cells(441, ActiveCell.Column).Comment Is Nothing Then
With Cells(441, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(441, ActiveCell.Column).Comment.Text
Cells(441, ActiveCell.Column).Comment.Delete
With Cells(441, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 30 To 40
Cells(446, ActiveCell.Column) = Cells(446, ActiveCell.Column) +  _
wert2_22
If Cells(446, ActiveCell.Column).Comment Is Nothing Then
With Cells(446, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(446, ActiveCell.Column).Comment. _
Text
Cells(446, ActiveCell.Column).Comment.Delete
With Cells(446, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 130 To 140
Cells(445, ActiveCell.Column - 1) = Cells(445, ActiveCell.Column - 1) -  _
wert2_22
If Cells(445, ActiveCell.Column - 1).Comment Is Nothing Then
With Cells(445, ActiveCell.Column - 1).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(445, ActiveCell.Column - 1).Comment. _
Text
Cells(445, ActiveCell.Column - 1).Comment.Delete
With Cells(445, ActiveCell.Column - 1).AddComment
.Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case -40 To -30
Cells(444, ActiveCell.Column) = Cells(444, ActiveCell.Column) + wert2_22
If Cells(444, ActiveCell.Column).Comment Is Nothing Then
With Cells(444, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(444, ActiveCell.Column).Comment.Text
Cells(444, ActiveCell.Column).Comment.Delete
With Cells(444, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 50 To 60
Cells(449, ActiveCell.Column) = Cells(449, ActiveCell.Column) +  _
wert2_22
If Cells(449, ActiveCell.Column).Comment Is Nothing Then
With Cells(449, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(449, ActiveCell.Column).Comment. _
Text
Cells(449, ActiveCell.Column).Comment.Delete
With Cells(449, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 150 To 160
Cells(448, ActiveCell.Column - 1) = Cells(448, ActiveCell.Column - 1) -  _
wert2_22
If Cells(448, ActiveCell.Column - 1).Comment Is Nothing Then
With Cells(448, ActiveCell.Column - 1).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(448, ActiveCell.Column - 1).Comment. _
Text
Cells(448, ActiveCell.Column - 1).Comment.Delete
With Cells(448, ActiveCell.Column - 1).AddComment
.Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case -20 To -10
Cells(447, ActiveCell.Column) = Cells(447, ActiveCell.Column) + wert2_22
If Cells(447, ActiveCell.Column).Comment Is Nothing Then
With Cells(447, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_22 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(447, ActiveCell.Column).Comment.Text
Cells(447, ActiveCell.Column).Comment.Delete
With Cells(447, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_22 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
End Select
End If
'=========================================================================================== _
'Kalenderliste Mehrarbeit nach Schicht
If akennz = 23 Then
Dim wert1_23 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
Dim wert2_23 As Double
wert1_23 = ActiveCell.Value
wert2_23 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_23 & " Stunde(n) FreiW-Mehrarbeit nach Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_23 & " Stunde(n) FreiW-Mehrarbeit nach Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Eintrag der Stunden in Zusatzpower
Dim number1 As Integer
number1 = ActiveCell
Select Case number1
Case 10 To 20
Cells(442, ActiveCell.Column) = Cells(442, ActiveCell.Column) + wert2_23
If Cells(442, ActiveCell.Column).Comment Is Nothing Then
With Cells(442, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(442, ActiveCell.Column).Comment.Text
Cells(442, ActiveCell.Column).Comment.Delete
With Cells(442, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 110 To 120
Cells(441, ActiveCell.Column) = Cells(441, ActiveCell.Column) - wert2_23
If Cells(441, ActiveCell.Column).Comment Is Nothing Then
With Cells(441, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(441, ActiveCell.Column).Comment.Text
Cells(441, ActiveCell.Column).Comment.Delete
With Cells(441, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case -20 To -10
Cells(443, ActiveCell.Column + 1) = Cells(443, ActiveCell.Column + 1) +  _
wert2_23
If Cells(443, ActiveCell.Column + 1).Comment Is Nothing Then
With Cells(443, ActiveCell.Column + 1).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(443, ActiveCell.Column + 1).Comment.Text
Cells(443, ActiveCell.Column + 1).Comment.Delete
With Cells(443, ActiveCell.Column + 1).AddComment
.Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 30 To 40
Cells(445, ActiveCell.Column) = Cells(445, ActiveCell.Column) + wert2_23
If Cells(445, ActiveCell.Column).Comment Is Nothing Then
With Cells(445, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(445, ActiveCell.Column).Comment.Text
Cells(445, ActiveCell.Column).Comment.Delete
With Cells(445, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 130 To 140
Cells(444, ActiveCell.Column) = Cells(444, ActiveCell.Column) - wert2_23
If Cells(444, ActiveCell.Column).Comment Is Nothing Then
With Cells(444, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & _
Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(444, ActiveCell.Column).Comment.Text
Cells(444, ActiveCell.Column).Comment.Delete
With Cells(444, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case -40 To -30
Cells(446, ActiveCell.Column + 1) = Cells(446, ActiveCell.Column + 1) +  _
wert2_23
If Cells(446, ActiveCell.Column + 1).Comment Is Nothing Then
With Cells(446, ActiveCell.Column + 1).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(446, ActiveCell.Column + 1).Comment.Text
Cells(446, ActiveCell.Column + 1).Comment.Delete
With Cells(446, ActiveCell.Column + 1).AddComment
.Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 50 To 60
Cells(448, ActiveCell.Column) = Cells(448, ActiveCell.Column) + wert2_23
If Cells(448, ActiveCell.Column).Comment Is Nothing Then
With Cells(448, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(448, ActiveCell.Column).Comment.Text
Cells(448, ActiveCell.Column).Comment.Delete
With Cells(448, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 150 To 160
Cells(447, ActiveCell.Column) = Cells(447, ActiveCell.Column) - wert2_23
If Cells(447, ActiveCell.Column).Comment Is Nothing Then
With Cells(447, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & _
Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(447, ActiveCell.Column).Comment.Text
Cells(447, ActiveCell.Column).Comment.Delete
With Cells(447, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case -60 To -50
Cells(449, ActiveCell.Column + 1) = Cells(449, ActiveCell.Column + 1) +  _
wert2_23
If Cells(449, ActiveCell.Column + 1).Comment Is Nothing Then
With Cells(449, ActiveCell.Column + 1).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_23 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(449, ActiveCell.Column + 1).Comment.Text
Cells(449, ActiveCell.Column + 1).Comment.Delete
With Cells(449, ActiveCell.Column + 1).AddComment
.Text vorhandener_Kommentar & wert2_23 & " Stunde(n) Zusatzpower" & Chr(10)  _
& Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
End Select
End If
'Kalenderliste Mehrarbeit vor Schicht
If akennz = 24 Then
Dim wert1_24 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
Dim wert2_24 As Double
wert1_24 = ActiveCell.Value
wert2_24 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Kommentar hinzufügen
If ActiveSheet.Cells(AktZeile + 1, AktSpalte).Value = "" Then
Cells(AktZeile + 1, AktSpalte).Value = " | " & Format(Date, "DD.MM.") & " - _
" & Application.UserName & ": " & wert2_24 & " Stunde(n) FreiW-Mehrarbeit vor Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
Else
vorhandener_Kommentar = Cells(AktZeile + 1, AktSpalte).Value
Cells(AktZeile + 1, AktSpalte).Value = ""
Cells(AktZeile + 1, AktSpalte).Value = vorhandener_Kommentar & " | " & Format( _
Date, "DD.MM.") & " - " & Application.UserName & ": " & wert2_24 & " Stunde(n) FreiW-Mehrarbeit vor Schicht " & Chr(34) & Kommentartext & Chr(34) & "  " & "|" & "  "
End If
'Eintrag der Stunden in Zusatzpower
Dim numbere1 As Integer
numbere1 = ActiveCell
Select Case numbere1
Case 10 To 20
Cells(443, ActiveCell.Column) = Cells(443, ActiveCell.Column) +  _
wert2_24
If Cells(443, ActiveCell.Column).Comment Is Nothing Then
With Cells(443, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(443, ActiveCell.Column).Comment. _
Text
Cells(443, ActiveCell.Column).Comment.Delete
With Cells(443, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 110 To 120
Cells(442, ActiveCell.Column - 1) = Cells(442, ActiveCell.Column - 1) -  _
wert2_24
If Cells(442, ActiveCell.Column - 1).Comment Is Nothing Then
With Cells(442, ActiveCell.Column - 1).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(442, ActiveCell.Column - 1).Comment. _
Text
Cells(442, ActiveCell.Column - 1).Comment.Delete
With Cells(442, ActiveCell.Column - 1).AddComment
.Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case -20 To -10
Cells(441, ActiveCell.Column) = Cells(441, ActiveCell.Column) + wert2_24
If Cells(441, ActiveCell.Column).Comment Is Nothing Then
With Cells(441, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(441, ActiveCell.Column).Comment.Text
Cells(441, ActiveCell.Column).Comment.Delete
With Cells(441, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 30 To 40
Cells(446, ActiveCell.Column) = Cells(446, ActiveCell.Column) +  _
wert2_24
If Cells(446, ActiveCell.Column).Comment Is Nothing Then
With Cells(446, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(446, ActiveCell.Column).Comment. _
Text
Cells(446, ActiveCell.Column).Comment.Delete
With Cells(446, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 130 To 140
Cells(445, ActiveCell.Column - 1) = Cells(445, ActiveCell.Column - 1) -  _
wert2_24
If Cells(445, ActiveCell.Column - 1).Comment Is Nothing Then
With Cells(445, ActiveCell.Column - 1).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(445, ActiveCell.Column - 1).Comment. _
Text
Cells(445, ActiveCell.Column - 1).Comment.Delete
With Cells(445, ActiveCell.Column - 1).AddComment
.Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case -40 To -30
Cells(444, ActiveCell.Column) = Cells(444, ActiveCell.Column) + wert2_24
If Cells(444, ActiveCell.Column).Comment Is Nothing Then
With Cells(444, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(444, ActiveCell.Column).Comment.Text
Cells(444, ActiveCell.Column).Comment.Delete
With Cells(444, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 50 To 60
Cells(449, ActiveCell.Column) = Cells(449, ActiveCell.Column) +  _
wert2_24
If Cells(449, ActiveCell.Column).Comment Is Nothing Then
With Cells(449, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) &  _
Chr(10) & Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(449, ActiveCell.Column).Comment. _
Text
Cells(449, ActiveCell.Column).Comment.Delete
With Cells(449, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case 150 To 160
Cells(448, ActiveCell.Column - 1) = Cells(448, ActiveCell.Column - 1) -  _
wert2_24
If Cells(448, ActiveCell.Column - 1).Comment Is Nothing Then
With Cells(448, ActiveCell.Column - 1).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(448, ActiveCell.Column - 1).Comment. _
Text
Cells(448, ActiveCell.Column - 1).Comment.Delete
With Cells(448, ActiveCell.Column - 1).AddComment
.Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
Case -20 To -10
Cells(447, ActiveCell.Column) = Cells(447, ActiveCell.Column) + wert2_24
If Cells(447, ActiveCell.Column).Comment Is Nothing Then
With Cells(447, ActiveCell.Column).AddComment
.Shape.TextFrame.AutoSize = True
.Text wert2_24 & " Stunde(n) Zusatzpower" & Chr(10) & Chr(10) &  _
Kommentartext & Chr(10) & Chr(10)
End With
Else
vorhandener_Kommentar = Cells(447, ActiveCell.Column).Comment.Text
Cells(447, ActiveCell.Column).Comment.Delete
With Cells(447, ActiveCell.Column).AddComment
.Text vorhandener_Kommentar & wert2_24 & " Stunde(n)  _
Zusatzpower" & Chr(10) & Chr(10) & Kommentartext & Chr(10) & Chr(10)
.Shape.TextFrame.AutoSize = True
End With
End If
End Select
End If
'Kalenderliste Mehrarbeit TZ
If akennz = 25 Then
Dim wert1_25 As Double 'Typendeklaration wichtig für dezimale Stundenangaben, z.B. 1, _
5!
Dim wert2_25 As Double
'          Dim schließen As Boolean
wert1_25 = ActiveCell.Value
wert2_25 = UserForm2.TextBox2.Value
Kommentartext = UserForm2.TextBox3.Value
'Abfrage ob MA TZ ist
If AktZeile >= 20 And AktZeile = 20 And AktZeile 

Private Sub CommandButton2_Click()
Unload UserForm2
End Sub


Ich Hoffe ihr könnt mir irgendwie weiter helfen?
Vielen Dank im Vorraus und Viele Grüße,
Nicolai S.

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA-Prozedur zu groß
08.10.2014 12:31:59
Daniel
Hi
naja, das ist mir jetzt zu viel, um mich da ohne Aufwandsentschädiungs durcharbeiten.
aber einen Tip zur Verkürzung kann ich dir geben:
wenn du statt der Optionbuttons 1-29 eine List- oder Combobox einsetzt, dann verkürzt sich dieser Codeteil:
 If d2.OptionButton1.Value = True Then
akennz = 1 'Arbeitsvorbereitung
ElseIf d2.OptionButton2.Value = True Then
akennz = 2 'Besprechung
ElseIf d2.OptionButton3.Value = True Then
akennz = 3 'Einarbeitung
ElseIf d2.OptionButton4.Value = True Then
akennz = 4 'Schulung
ElseIf d2.OptionButton5.Value = True Then
akennz = 5 'KVP
ElseIf d2.OptionButton6.Value = True Then
akennz = 6 'Erste Hilfe
ElseIf d2.OptionButton7.Value = True Then
akennz = 7 'EBA
ElseIf d2.OptionButton8.Value = True Then
akennz = 8 'QS
ElseIf d2.OptionButton9.Value = True Then
akennz = 9 'BR
ElseIf d2.OptionButton10.Value = True Then
akennz = 10 'Anlagenausfall
ElseIf d2.OptionButton11.Value = True Then
akennz = 11 'Springer
ElseIf d2.OptionButton12.Value = True Then
akennz = 12 'Sonstiges
ElseIf d2.OptionButton13.Value = True Then
akennz = 13 'ZE
ElseIf d2.OptionButton14.Value = True Then
akennz = 14 'Ebenenwechsel
ElseIf d2.OptionButton15.Value = True Then
akennz = 15 'Zusatzpower
ElseIf d2.OptionButton16.Value = True Then
akennz = 16 'FreiW Mehrarbeit TZ
ElseIf d2.OptionButton17.Value = True Then
akennz = 17 'krank nach Hause
ElseIf d2.OptionButton18.Value = True Then
akennz = 18 'Fähigkeitenwerkstatt
' If d2.OptionButton19.Value = True Then akennz = 19 'Mini-CttC
ElseIf d2.OptionButton20.Value = True Then
akennz = 20 'ProFit
ElseIf d2.OptionButton21.Value = True Then
akennz = 21 'FreiW Mehrarbeit nach Schicht
ElseIf d2.OptionButton22.Value = True Then
akennz = 22 'FreiW Mehrarbeit vor Schicht
ElseIf d2.OptionButton23.Value = True Then
akennz = 23 'Kal.Mehrarbeit nach Schicht
ElseIf d2.OptionButton24.Value = True Then
akennz = 24 'Kal.Mehrarbeit vor Schicht
ElseIf d2.OptionButton25.Value = True Then
akennz = 25 'KalMehrarbeit TZ
ElseIf d2.OptionButton26.Value = True Then
akennz = 26 'Ang. Mehrarbeit nach Schicht
ElseIf d2.OptionButton27.Value = True Then
akennz = 27 'Ang. Mehrarbeit vor Schicht
ElseIf d2.OptionButton28.Value = True Then
akennz = 28 'Ang.Mehrarbeit TZ
ElseIf d2.OptionButton29.Value = True Then
akennz = 29 'Info Kommentar
Else
MsgBox ("Bitte Grund für Eintragung auswählen")
Exit Sub
End If
zu:
If Combobox1.ListIndex = -1 Then
MsgBox ("Bitte Grund für Eintragung auswählen")
Exit Sub
Else
akennz = Combobox1.ListIndex + 1
end If
Gruß Daniel

Anzeige
AW: VBA-Prozedur zu groß
08.10.2014 13:08:55
Nicolai
Selbst wenn ich dieses Abschnitt kürze, wäre es immer noch zu lang.
Gibt es nicht eine möglichkeit mit "Call Prozdeur" das er den Code trotzdem ausführt?
Vielen Dank & Grüße,
Nicolai

AW: VBA-Prozedur zu groß
08.10.2014 13:47:23
Daniel
Hi
weiterhin ist es unsinn, dass du für jeden Fall eigene Variablen anlegst und dann den kompletten Code wiederholst.
du brauchst kein wert1_1, wert1_2, wert1_3, ..., wert1_29
der Anwender kann ja immer nur eine Option auswählen, deswegen reicht ein wert1
im Code sind dann ja viele Befehle für alle Optionen gleich, diese kannst du dann bei allen Fällen ausführen, dann musst du sie auch nur 1x hinschreiben und nicht 29x wiederholen.
Eine Fallunterscheidung machst du dann nur für die Fälle, die sich unterscheiden.
momentan ist dies deine Programmstruktur:

FAllUNTERSCHEIDUNG
Fall 1
Code der bei allen Fällen ausgeführt werden muss
Code Fall 1 - Spezifisch
Code der bei allen Fällen ausgeführt werden muss
Fall 2
Code der bei allen Fällen ausgeführt werden muss
Code Fall 2 - Spezifisch
Code der bei allen Fällen ausgeführt werden muss
Fall 3
Code der bei allen Fällen ausgeführt werden muss
Code Fall 3 - Spezifisch
Code der bei allen Fällen ausgeführt werden muss
ENDE FALLUNTERSCHEIDUNG
du solltest jedoch folgende Struktur anstreben:
Code der bei allen Fällen ausgeführt werden muss
FALLUNTERSCHEIDUNG
Fall 1
Fall 1 - spezifischer Code
Fall 2
Fall 2 - spezifischer Code
Fall 3
Fall 3 - spezifischer Code
ENDE FALLUNTERSCHEIDUNG
Code der in allen Fällen ausgeführt werden muss
Gruß Daniel

Anzeige
AW: VBA-Prozedur zu groß
08.10.2014 13:56:31
Michael
Hallo Nicolai,
zunächst möchte ich mich Daniel anschließen: zu viel Arbeit für lau.
Wenn Daniels Vorschlag nicht zur Lösung Deines Problems führt, erhebt sich die Frage, was Du denn zwischen dem letzten funktionsfähigen Stand und dem jetzigen, wo es nicht mehr geht, gemacht hast.
Um Dich zu zitieren:
"ich habe gerade mein Marko erweitert und dann kamm die Fehlermeldung das die Prozedur zu groß ist."
Grundsätzlich hat eine prozedurale Sprache wie VBA je den Vorteil, daß man einzelne Sachen in S*U*Bs verpacken kann. Du kannst also "einfache Teile" auslagern und aufrufen, damit die Prozedur kleiner wird, oder Du kannst "ähnlich wiederkehrende Teile" auslagern und mit entsprechenden Variablen aufrufen.
Ich hab mir mal die Teile ab
If akennz = 2 Then
und
If akennz = 3 Then
nebeneinander in eine Tabelle (ab A1 bzw. J1) kopiert, um Unterschiede zu sehen: beide Dinger machen exakt das Gleiche, bis auf:
Zeile 13 und 19: "Besprechung" bzw. "Einarbeitung"
Zeile 32, 35 und 37: unterschiedliche Zeilennummern, in die die Werte geschrieben werden.
Wenn Du das in eine Prozedur auslagerst, brauchst Du nur den geänderten Text bzw. die Zellen bzw. Nummern beim Aufruf mit zu übergeben, und schon verkürzt sich alles, etwa so:
If akennz = 2 Then Werte_Schreiben("Besprechung",332,476,496)
If akennz = 3 Then Werte_Schreiben("Einarbeitung",332,477,497)
Und das noch: Deine Prozedur wird von oben bis unten durchlaufen, und Du deklarierst wild Variablen, die exakt das gleiche tun, x-fach...
Dim wert1_2 As Double
... ohne sie hinterher noch einmal zu verwenden. Einmal am Anfang reicht völlig.
Bis dahin umsonst.
Schöne Grüße,
Michael

Anzeige
Nachtrag
08.10.2014 14:02:43
Michael
Das noch: habe die zwei Werte vergessen. Ein Prozeduraufruf könnte dann also heißen:
If akennz = 2 Then Werte_Schreiben("Besprechung",332,476,496,wert1,wert2)
oder, weil extra Variablen eigentlich unnötig sind:
If akennz = 2 Then Werte_Schreiben("Besprechung",332,476,496, _
ActiveCell.Value,UserForm2.TextBox2.Value)

122 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige