Private Sub Workbook_BeforeClose(Cancel As Boolean) 
Application.EnableCancelKey = xlDisabled 
ThisWorkbook.Unprotect passw 
Sheets("xxxxxx").CommandButton1.visible = True 
Dim m As String 
m = ThisWorkbook.Name 
If (Environ("COMPUTERNAME") = ComPuterName1 And GetSetting("xxxxxx", _
"xxxxxx", "xxxxxx") = GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Or _
(Environ("COMPUTERNAME") = ComPuterName2 And GetSetting("xxxxxx", _
"xxxxxx", "xxxxxx") = GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Then 
ThisWorkbook.Protect passw 
ActiveWorkbook.Save 
ElseIf Sheets("xxxxxx").Range("F5").value = "" Or Sheets("xxxxxx").Range("F6").value = "" Or _
Sheets("xxxxxx").Range("F7").value = "" Or Sheets("xxxxxx").Range("F8").value = "" Or _
Sheets("xxxxxx").Range("K5").value = "" Then 
Application.DisplayFormulaBar = True 
Application.CommandBars("Cell").Enabled = True 
Application.CommandBars("PLY").Enabled = True 
Application.CommandBars("Row").Enabled = True 
Application.CommandBars("Column").Enabled = True 
Application.DisplayStatusBar = True 
Sheets("xxxxxx").visible = xlVeryHidden 
Sheets("xxxxxx").visible = xlVeryHidden 
Sheets("xxxxxx").Activate 
ThisWorkbook.Protect passw 
ActiveWorkbook.Save 
ElseIf GetSetting("xxxxxx", "xxxxxx", m) <> m Then 
SaveSetting "xxxxxx", "xxxxxx", m, m 
Application.DisplayFormulaBar = True 
Application.CommandBars("Cell").Enabled = True 
Application.CommandBars("PLY").Enabled = True 
Application.CommandBars("Row").Enabled = True 
Application.CommandBars("Column").Enabled = True 
Application.DisplayStatusBar = True 
Sheets("xxxxxx").visible = xlVeryHidden 
Sheets("xxxxxx").visible = xlVeryHidden 
Sheets("xxxxxx").visible = xlVeryHidden 
Sheets("xxxxxx").Activate 
ThisWorkbook.Protect passw 
ActiveWorkbook.Save 
Else 
Application.ScreenUpdating = False 
Sheets("xxxxxx").visible = xlVeryHidden 
Sheets("xxxxxx").visible = xlVeryHidden 
Sheets("xxxxxx").visible = xlVeryHidden 
Sheets("xxxxxx").Activate 
ThisWorkbook.Protect passw 
Application.ScreenUpdating = True 
Application.DisplayFormulaBar = True 
Application.CommandBars("Cell").Enabled = True 
Application.CommandBars("PLY").Enabled = True 
Application.CommandBars("Row").Enabled = True 
Application.CommandBars("Column").Enabled = True 
Application.DisplayStatusBar = True 
ActiveWorkbook.Save 
End If 
End Sub 
Private Sub workbook_open() 
Application.EnableCancelKey = xlDisabled 
On Error Resume Next 
Dim blatt As Object 
Dim m As String 
m = ThisWorkbook.Name 
For Each blatt In ActiveWorkbook.Sheets 
Application.ScreenUpdating = False 
With blatt 
.Protect passw 
.EnableSelection = xlUnlockedCells 
End With 
Next blatt 
Application.ScreenUpdating = True 
Sheets("xxxxxx").ScrollArea = "A1:C27" 
Rem Sheets("Tabelle4").ScrollArea = "A1:AK55" 
Sheets("xxxxxx").ScrollArea = "A1:W22" 
Sheets("xxxxxx").ScrollArea = "A1:AF1229" 
If (Environ("COMPUTERNAME") = ComPuterName1 And GetSetting("xxxxxx", _
"xxxxxx", "xxxxxx") = GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Or _
(Environ("COMPUTERNAME") = ComPuterName2 And GetSetting("xxxxxx", "xxxxxx", _
"xxxxxx") = GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Then GoTo Ende 
If GetSetting("xxxxxx", "xxxxxx", "xxxxxx") <> "xxxxxx" Then userform1.Show 
If GetSetting("xxxxxx", "xxxxxx", "xxxxxx") <> "xxxxxx" Or _
GetSetting("xxxxxx", "xxxxxx", m) <> ThisWorkbook.Name Then 
Start: 
Application.ScreenUpdating = False 
Sheets("xxxxxx").CommandButton1.visible = True 
Sheets("xxxxxx").Activate 
Range("F5").Select 
MsgBox "Sie müssen zuerst Ihre persönliche Daten und " & vbcrfl & _
       "die notwendigen Zeitangaben eintragen!. " & vbCrLf & vbCrLf & _
       "Klicken Sie zum Abschluß auf die Schaltfläche ""Einstellungen speichern""! " & vbCrLf & _
       "Bis zur Speicherung der Angaben wird diese Seite " & _
       "bei jedem Start angezeigt. ", vbOKOnly + vbExclamation, "Hinweis" 
Sheets("xxxxxx").visible = xlVeryHidden 
Rem Sheets("Tabelle4").visible = xlVeryHidden 
Sheets("xxxxxx").visible = xlVeryHidden 
Sheets("xxxxxx").visible = xlVeryHidden 
Sheets("xxxxxx").Activate 
Range("F5").Select 
ActiveWindow.SmallScroll Down:=-1234 
ThisWorkbook.Protect passw 
Application.ScreenUpdating = True 
Exit Sub 
Else 
Application.ScreenUpdating = False 
ThisWorkbook.Unprotect passw 
Sheets("xxxxxx").visible = True 
Sheets("xxxxxx").visible = True 
Sheets("xxxxxx").visible = True 
Sheets("xxxxxx").CommandButton1.visible = False 
Sheets("xxxxxx").Activate 
ThisWorkbook.Protect passw 
Application.ScreenUpdating = False 
Exit Sub 
End If 
Ende: 
Application.ScreenUpdating = False 
Sheets("xxxxxx").CommandButton1.visible = True 
Sheets("xxxxxx").visible = True 
Sheets("xxxxxx").visible = True 
Sheets("xxxxxx").visible = True 
Sheets("xxxxxx").Activate 
Rem ThisWorkbook.Protect passw 
Application.ScreenUpdating = True 
End Sub 
Private Sub workbook_activate() 
Application.DisplayStatusBar = False 
End Sub 
Private Sub workbook_deactivate() 
Application.DisplayStatusBar = True 
End Sub 
Private Sub Workbook_SheetActivate(ByVal Sh As Object) 
On Error Resume Next 
If Not objRibbon Is Nothing Then objRibbon.Invalidate 
End Sub 

Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean) 
Cancel = True 
MsgBox "Die Zellformate dürfen nicht verändert werden. " & vbCrLf & _
       "Der Doppelklick wurde deaktiviert." & vbCrLf & _
       "Zugriff auf die Zellen verweigert. ", vbOKOnly + vbExclamation, "Hinweis" 
End Sub 
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean) 
Cancel = True 
MsgBox "Die Zellformate dürfen nicht verändert werden. " & vbCrLf & _
       "Die rechte Maustaste wurde deaktiviert." & vbCrLf & _
       "Zugriff auf das Kontextmenü verweigert. ", vbOKOnly + vbExclamation, "Hinweis" 
End Sub 
Private Sub Worksheet_Activate() 
If (Environ("COMPUTERNAME") = ComPuterName1 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Or _
(Environ("COMPUTERNAME") = ComPuterName2 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Then Exit Sub 
ActiveWindow.DisplayWorkbookTabs = False 
ActiveWindow.DisplayHeadings = False 
End Sub 
 

Private Sub CommandButton1_Click() 
Application.EnableCancelKey = False 
Dim DistAZ As String 
Dim xxxxxx As String 
Dim DistMap As String 
Dim m As String 
Dim n As String 
Dim x As String 
n = ThisWorkbook.Name 
m = Environ("USERNAME") 
DistMap = m 
DistAZ = "xxxxxx" 
xxxxxx = Sheets("xxxxxx").Range("F4").value 
If Sheets("xxxxxx").Range("F5").value = "" Or Sheets("xxxxxx").Range("F6").value = "" Or _
Sheets("xxxxxx").Range("F7").value = "" Or Sheets("xxxxxx").Range("F8").value = "" Or _
Sheets("xxxxxx").Range("K5").value = "" Then 
MsgBox "Bitte vervollständigen Sie erst Ihre " & vbCrLf & _
       "persönlichen Daten. Ohne diese Angaben " & vbCrLf & _
       "können Sie die Einstellungen nicht speichern.", vbOKOnly + vbExclamation, "Warnung" 
Else 
Application.ScreenUpdating = False 
x = ThisWorkbook.Name 
SaveSetting "xxxxxx", "xxxxxx", "xxxxxx", "xxxxxx" 
SaveSetting "xxxxxx", "xxxxxx", "xxxxxx", xxxxxx 
SaveSetting "xxxxxx", "xxxxxx", "xxxxxx", "xxxxxx" 
SaveSetting "xxxxxx", "xxxxxx", x, x 
SaveSetting "xxxxxx", "xxxxxx", "xxxxxx", "xxxxxx" 
Sheets("xxxxxx").CommandButton1.visible = False 
objRibbon.Invalidate 
ThisWorkbook.Unprotect passw 
Sheets("xxxxxx").visible = True 
Sheets("xxxxxx").visible = True 
Sheets("xxxxxx").visible = True 
Sheets("xxxxxx").Activate 
ActiveWorkbook.SaveAs ThisWorkbook.Sheets("xxxxxx").Range("K7").value 
ThisWorkbook.Protect passw 
Application.ScreenUpdating = True 
End If 
Ende: 
End Sub 
Private Sub worksheet_change(ByVal target As Range) 
On Error GoTo Ende 
If target.Address = "$F$4" Then Call Aendern 
Ende: 
End Sub 
Private Sub Worksheet_Activate() 
If (Environ("COMPUTERNAME") = ComPuterName1 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Or _
(Environ("COMPUTERNAME") = ComPuterName2 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Then Exit Sub 
ActiveWindow.DisplayWorkbookTabs = False 
ActiveWindow.DisplayHeadings = False 
End Sub 
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean) 
Cancel = True 
MsgBox "Die Zellformate dürfen nicht verändert werden. " & vbCrLf & _
       "Der Doppelklick wurde deaktiviert." & vbCrLf & _
       "Zugriff auf die Zellen verweigert. ", vbOKOnly + vbExclamation, "Hinweis" 
End Sub 
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean) 
Cancel = True 
MsgBox "Die Zellformate dürfen nicht verändert werden. " & vbCrLf & _
       "Die rechte Maustaste wurde deaktiviert." & vbCrLf & _
       "Zugriff auf das Kontextmenü verweigert. ", vbOKOnly + vbExclamation, "Hinweis" 
End Sub 

Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean) 
Cancel = True 
MsgBox "Die Zellformate dürfen nicht verändert werden. " & vbCrLf & _
       "Der Doppelklick wurde deaktiviert." & vbCrLf & _
       "Zugriff auf die Zellen verweigert. ", vbOKOnly + vbExclamation, "Hinweis" 
End Sub 
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean) 
Cancel = True 
MsgBox "Die Zellformate dürfen nicht verändert werden. " & vbCrLf & _
       "Die rechte Maustaste wurde deaktiviert." & vbCrLf & _
       "Zugriff auf das Kontextmenü verweigert. ", vbOKOnly + vbExclamation, "Hinweis" 
End Sub 
Private Sub Worksheet_Activate() 
If (Environ("COMPUTERNAME") = ComPuterName1 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Or _
(Environ("COMPUTERNAME") = ComPuterName2 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Then Exit Sub 
ActiveWindow.DisplayWorkbookTabs = False 
ActiveWindow.DisplayHeadings = False 
End Sub 

Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean) 
Cancel = True 
MsgBox "Die Zellformate dürfen nicht verändert werden. " & vbCrLf & _
       "Der Doppelklick wurde deaktiviert." & vbCrLf & _
       "Zugriff auf die Zellen verweigert. ", vbOKOnly + vbExclamation, "Hinweis" 
End Sub 
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean) 
Cancel = True 
MsgBox "Die Zellformate dürfen nicht verändert werden. " & vbCrLf & _
       "Die rechte Maustaste wurde deaktiviert." & vbCrLf & _
       "Zugriff auf das Kontextmenü verweigert. ", vbOKOnly + vbExclamation, "Hinweis" 
End Sub 
Private Sub Worksheet_Activate() 
If (Environ("COMPUTERNAME") = ComPuterName1 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("RMH_Installationen", "xxxxxx", "xxxxx")) Or _
(Environ("COMPUTERNAME") = ComPuterName2 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Then Exit Sub 
ActiveWindow.DisplayWorkbookTabs = False 
ActiveWindow.DisplayHeadings = False 
End Sub 
 

Option Explicit 
Private Sub CommandButton1_Click() 
TextBox7.Text = Format(CDbl(TextBox7.Text), "h:mm") 
End Sub 
Private Sub Label222_Click() 
Application.ScreenUpdating = False 
Dim iTage   As Integer 
Dim dZeit   As Date 
Dim iZeit   As Integer 
Dim iBeit   As Integer 
Dim iposit  As Integer 
Dim iposit2 As Integer 
Dim iWoche As Integer 
   iWoche = TextBox2.value 
   iTage = CInt(TextBox1.value) 
   iposit = InStr(TextBox3.value, ":") 
   iposit2 = InStr(TextBox21.value, ":") 
   If iposit > 0 Then 
      iZeit = (CInt(Left(TextBox3.value, iposit - 1) * 60) + _
             CInt(Right(TextBox3.value, Len(TextBox3.value) - iposit))) 
      Else 
      MsgBox "bitte eine gültige Zeitangabe (hh:mm) eingeben.", _
         48, "   " & Date & "   Hinweis für " & Application.UserName 
      With TextBox2 
         .SetFocus 
         .SelStart = 0 
         .SelLength = Len(.Text) 
      End With 
      Exit Sub 
   End If 
   TextBox6.value = Format(Int(iZeit / iWoche * iTage / 60) + (iZeit / iWoche * iTage / 60 - _
     Int(iZeit / iWoche * iTage / 60)) * 60 / 100, "#0.00") 
   TextBox6.value = Replace(TextBox6.value, ",", ":") 
Dim iHH As Integer 
Dim iMM As Integer 
Dim iDD As Integer 
iHH = GetTextBox6Value 
TextBox24.value = iHH & ":00" 
Sheets("xxxxxx").Unprotect passw 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = False 
Sheets("xxxxxx").Range("D1").value = TextBox24.value 
Sheets("xxxxxx").Range("D2").value = TextBox21.value 
Sheets("xxxxxx").Range("D3").value = TextBox25.value 
TextBox7.value = Sheets("xxxxxx").Range("D4").Text 
TextBox21.value = "" 
TextBox25.value = "" 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = True 
Sheets("xxxxxx").Protect passw 
Application.ScreenUpdating = False 
End Sub 
Private Sub Label223_Click() 
On Error Resume Next 
Application.ScreenUpdating = False 
Dim iTage   As Integer 
Dim dZeit   As Date 
Dim iZeit   As Integer 
Dim iBeit   As Integer 
Dim iposit  As Integer 
Dim iposit2 As Integer 
Dim iWoche As Integer 
   iWoche = TextBox2.value 
   iTage = CInt(TextBox1.value) 
   iposit = InStr(TextBox3.value, ":") 
   iposit2 = InStr(TextBox21.value, ":") 
   If iposit > 0 Then 
      iZeit = (CInt(Left(TextBox3.value, iposit - 1) * 60) + _
             CInt(Right(TextBox3.value, Len(TextBox3.value) - iposit))) 
      Else 
      MsgBox "bitte eine gültige Zeitangabe (hh:mm) eingeben.", _
         48, "   " & Date & "   Hinweis für " & Application.UserName 
      With TextBox2 
         .SetFocus 
         .SelStart = 0 
         .SelLength = Len(.Text) 
      End With 
      Exit Sub 
   End If 
   TextBox6.value = Format(Int(iZeit / iWoche * iTage / 60) + (iZeit / iWoche * iTage / 60 - _
     Int(iZeit / iWoche * iTage / 60)) * 60 / 100, "#0.00") 
   TextBox6.value = Replace(TextBox6.value, ",", ":") 
Dim iHH As Integer 
Dim iMM As Integer 
Dim iDD As Integer 
iHH = GetTextBox6Value 
TextBox24.value = iHH & ":00" 
Sheets("xxxxxx").Unprotect passw 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = False 
Sheets("xxxxxx").Range("D1").value = TextBox24.value 
Sheets("xxxxxx").Range("D2").value = TextBox21.value 
Sheets("xxxxxx").Range("D3").value = TextBox25.value 
TextBox8.value = Sheets("xxxxxx").Range("D4").Text 
TextBox21.value = "" 
TextBox25.value = "" 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = True 
Sheets("xxxxxx").Protect passw 
Application.ScreenUpdating = False 
End Sub 
Private Sub Label224_Click() 
On Error Resume Next 
Application.ScreenUpdating = False 
Dim iTage   As Integer 
Dim dZeit   As Date 
Dim iZeit   As Integer 
Dim iBeit   As Integer 
Dim iposit  As Integer 
Dim iposit2 As Integer 
Dim iWoche As Integer 
   iWoche = TextBox2.value 
   iTage = CInt(TextBox1.value) 
   iposit = InStr(TextBox3.value, ":") 
   iposit2 = InStr(TextBox21.value, ":") 
   If iposit > 0 Then 
      iZeit = (CInt(Left(TextBox3.value, iposit - 1) * 60) + _
             CInt(Right(TextBox3.value, Len(TextBox3.value) - iposit))) 
    Else 
      MsgBox "bitte eine gültige Zeitangabe (hh:mm) eingeben.", _
         48, "   " & Date & "   Hinweis für " & Application.UserName 
      With TextBox2 
         .SetFocus 
         .SelStart = 0 
         .SelLength = Len(.Text) 
      End With 
      Exit Sub 
   End If 
   TextBox6.value = Format(Int(iZeit / iWoche * iTage / 60) + (iZeit / iWoche * iTage / 60 - _
     Int(iZeit / iWoche * iTage / 60)) * 60 / 100, "#0.00") 
   TextBox6.value = Replace(TextBox6.value, ",", ":") 
Dim iHH As Integer 
Dim iMM As Integer 
Dim iDD As Integer 
iHH = GetTextBox6Value 
TextBox24.value = iHH & ":00" 
Sheets("xxxxxx").Unprotect passw 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = False 
Sheets("xxxxxx").Range("D1").value = TextBox24.value 
Sheets("xxxxxx").Range("D2").value = TextBox21.value 
Sheets("xxxxxx").Range("D3").value = TextBox25.value 
TextBox9.value = Sheets("xxxxxx").Range("D4").Text 
TextBox21.value = "" 
TextBox25.value = "" 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = True 
Sheets("xxxxxx").Protect passw 
Application.ScreenUpdating = False 
End Sub 
Private Sub Label225_Click() 
On Error Resume Next 
Application.ScreenUpdating = False 
Dim iTage   As Integer 
Dim dZeit   As Date 
Dim iZeit   As Integer 
Dim iBeit   As Integer 
Dim iposit  As Integer 
Dim iposit2 As Integer 
Dim iWoche As Integer 
   iWoche = TextBox2.value 
   iTage = CInt(TextBox1.value) 
   iposit = InStr(TextBox3.value, ":") 
   iposit2 = InStr(TextBox21.value, ":") 
   If iposit > 0 Then 
      iZeit = (CInt(Left(TextBox3.value, iposit - 1) * 60) + _
             CInt(Right(TextBox3.value, Len(TextBox3.value) - iposit))) 
    Else 
      MsgBox "bitte eine gültige Zeitangabe (hh:mm) eingeben.", _
         48, "   " & Date & "   Hinweis für " & Application.UserName 
      With TextBox2 
         .SetFocus 
         .SelStart = 0 
         .SelLength = Len(.Text) 
      End With 
      Exit Sub 
   End If 
   TextBox6.value = Format(Int(iZeit / iWoche * iTage / 60) + (iZeit / iWoche * iTage / 60 - _
     Int(iZeit / iWoche * iTage / 60)) * 60 / 100, "#0.00") 
   TextBox6.value = Replace(TextBox6.value, ",", ":") 
Dim iHH As Integer 
Dim iMM As Integer 
Dim iDD As Integer 
iHH = GetTextBox6Value 
TextBox24.value = iHH & ":00" 
Sheets("xxxxxx").Unprotect passw 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = False 
Sheets("xxxxxx").Range("D1").value = TextBox24.value 
Sheets("xxxxxx").Range("D2").value = TextBox21.value 
Sheets("xxxxxx").Range("D3").value = TextBox25.value 
TextBox10.value = Sheets("xxxxxx").Range("D4").Text 
TextBox21.value = "" 
TextBox25.value = "" 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = True 
Sheets("xxxxxx").Protect passw 
Application.ScreenUpdating = False 
End Sub 
Private Sub Label226_Click() 
On Error Resume Next 
Application.ScreenUpdating = False 
Dim iTage   As Integer 
Dim dZeit   As Date 
Dim iZeit   As Integer 
Dim iBeit   As Integer 
Dim iposit  As Integer 
Dim iposit2 As Integer 
Dim iWoche As Integer 
   iWoche = TextBox2.value 
   iTage = CInt(TextBox1.value) 
   iposit = InStr(TextBox3.value, ":") 
   iposit2 = InStr(TextBox21.value, ":") 
   If iposit > 0 Then 
      iZeit = (CInt(Left(TextBox3.value, iposit - 1) * 60) + _
             CInt(Right(TextBox3.value, Len(TextBox3.value) - iposit))) 
    Else 
      MsgBox "bitte eine gültige Zeitangabe (hh:mm) eingeben.", _
         48, "   " & Date & "   Hinweis für " & Application.UserName 
      With TextBox2 
         .SetFocus 
         .SelStart = 0 
         .SelLength = Len(.Text) 
      End With 
      Exit Sub 
   End If 
   TextBox6.value = Format(Int(iZeit / iWoche * iTage / 60) + (iZeit / iWoche * iTage / 60 - _
     Int(iZeit / iWoche * iTage / 60)) * 60 / 100, "#0.00") 
   TextBox6.value = Replace(TextBox6.value, ",", ":") 
Dim iHH As Integer 
Dim iMM As Integer 
Dim iDD As Integer 
iHH = GetTextBox6Value 
TextBox24.value = iHH & ":00" 
Sheets("xxxxxx").Unprotect passw 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = False 
Sheets("xxxxxx").Range("D1").value = TextBox24.value 
Sheets("xxxxxx").Range("D2").value = TextBox21.value 
Sheets("xxxxxx").Range("D3").value = TextBox25.value 
TextBox11.value = Sheets("xxxxxx").Range("D4").Text 
TextBox21.value = "" 
TextBox25.value = "" 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = True 
Sheets("xxxxxx").Protect passw 
Application.ScreenUpdating = False 
End Sub 
Private Sub Label227_Click() 
On Error Resume Next 
Application.ScreenUpdating = False 
Dim iTage   As Integer 
Dim dZeit   As Date 
Dim iZeit   As Integer 
Dim iBeit   As Integer 
Dim iposit  As Integer 
Dim iposit2 As Integer 
Dim iWoche As Integer 
   iWoche = TextBox2.value 
   iTage = CInt(TextBox1.value) 
   iposit = InStr(TextBox3.value, ":") 
   iposit2 = InStr(TextBox21.value, ":") 
   If iposit > 0 Then 
      iZeit = (CInt(Left(TextBox3.value, iposit - 1) * 60) + _
             CInt(Right(TextBox3.value, Len(TextBox3.value) - iposit))) 
    Else 
      MsgBox "bitte eine gültige Zeitangabe (hh:mm) eingeben.", _
         48, "   " & Date & "   Hinweis für " & Application.UserName 
      With TextBox2 
         .SetFocus 
         .SelStart = 0 
         .SelLength = Len(.Text) 
      End With 
      Exit Sub 
   End If 
   TextBox6.value = Format(Int(iZeit / iWoche * iTage / 60) + (iZeit / iWoche * iTage / 60 - _
     Int(iZeit / iWoche * iTage / 60)) * 60 / 100, "#0.00") 
   TextBox6.value = Replace(TextBox6.value, ",", ":") 
Dim iHH As Integer 
Dim iMM As Integer 
Dim iDD As Integer 
iHH = GetTextBox6Value 
TextBox24.value = iHH & ":00" 
Sheets("xxxxxx").Unprotect passw 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = False 
Sheets("xxxxxx").Range("D1").value = TextBox24.value 
Sheets("xxxxxx").Range("D2").value = TextBox21.value 
Sheets("xxxxxx").Range("D3").value = TextBox25.value 
TextBox12.value = Sheets("xxxxxx").Range("D4").Text 
TextBox21.value = "" 
TextBox25.value = "" 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = True 
Sheets("xxxxxx").Protect passw 
Application.ScreenUpdating = False 
End Sub 
Private Sub Label228_Click() 
On Error Resume Next 
Application.ScreenUpdating = False 
Dim iTage   As Integer 
Dim dZeit   As Date 
Dim iZeit   As Integer 
Dim iBeit   As Integer 
Dim iposit  As Integer 
Dim iposit2 As Integer 
Dim iWoche As Integer 
   iWoche = TextBox2.value 
   iTage = CInt(TextBox1.value) 
   iposit = InStr(TextBox3.value, ":") 
   iposit2 = InStr(TextBox21.value, ":") 
   If iposit > 0 Then 
      iZeit = (CInt(Left(TextBox3.value, iposit - 1) * 60) + _
             CInt(Right(TextBox3.value, Len(TextBox3.value) - iposit))) 
    Else 
      MsgBox "bitte eine gültige Zeitangabe (hh:mm) eingeben.", _
         48, "   " & Date & "   Hinweis für " & Application.UserName 
      With TextBox2 
         .SetFocus 
         .SelStart = 0 
         .SelLength = Len(.Text) 
      End With 
      Exit Sub 
   End If 
   TextBox6.value = Format(Int(iZeit / iWoche * iTage / 60) + (iZeit / iWoche * iTage / 60 - _
     Int(iZeit / iWoche * iTage / 60)) * 60 / 100, "#0.00") 
   TextBox6.value = Replace(TextBox6.value, ",", ":") 
Dim iHH As Integer 
Dim iMM As Integer 
Dim iDD As Integer 
iHH = GetTextBox6Value 
TextBox24.value = iHH & ":00" 
Sheets("xxxxxx").Unprotect passw 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = False 
Sheets("xxxxxx").Range("D1").value = TextBox24.value 
Sheets("xxxxxx").Range("D2").value = TextBox21.value 
Sheets("xxxxxx").Range("D3").value = TextBox25.value 
TextBox13.value = Sheets("xxxxxx").Range("D4").Text 
TextBox21.value = "" 
TextBox25.value = "" 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = True 
Sheets("xxxxxx").Protect passw 
Application.ScreenUpdating = False 
End Sub 
Private Sub Label229_Click() 
On Error Resume Next 
Application.ScreenUpdating = False 
Dim iTage   As Integer 
Dim dZeit   As Date 
Dim iZeit   As Integer 
Dim iBeit   As Integer 
Dim iposit  As Integer 
Dim iposit2 As Integer 
Dim iWoche As Integer 
   iWoche = TextBox2.value 
   iTage = CInt(TextBox1.value) 
   iposit = InStr(TextBox3.value, ":") 
   iposit2 = InStr(TextBox21.value, ":") 
   If iposit > 0 Then 
      iZeit = (CInt(Left(TextBox3.value, iposit - 1) * 60) + _
             CInt(Right(TextBox3.value, Len(TextBox3.value) - iposit))) 
       Else 
      MsgBox "bitte eine gültige Zeitangabe (hh:mm) eingeben.", _
         48, "   " & Date & "   Hinweis für " & Application.UserName 
      With TextBox2 
         .SetFocus 
         .SelStart = 0 
         .SelLength = Len(.Text) 
      End With 
      Exit Sub 
   End If 
   TextBox6.value = Format(Int(iZeit / iWoche * iTage / 60) + (iZeit / iWoche * iTage / 60 - _
     Int(iZeit / iWoche * iTage / 60)) * 60 / 100, "#0.00") 
   TextBox6.value = Replace(TextBox6.value, ",", ":") 
Dim iHH As Integer 
Dim iMM As Integer 
Dim iDD As Integer 
iHH = GetTextBox6Value 
TextBox24.value = iHH & ":00" 
Sheets("xxxxxx").Unprotect passw 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = False 
Sheets("xxxxxx").Range("D1").value = TextBox24.value 
Sheets("xxxxxx").Range("D2").value = TextBox21.value 
Sheets("xxxxxx").Range("D3").value = TextBox25.value 
TextBox14.value = Sheets("xxxxxx").Range("D4").Text 
TextBox21.value = "" 
TextBox25.value = "" 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = True 
Sheets("xxxxxx").Protect passw 
Application.ScreenUpdating = False 
End Sub 
Private Sub Label230_Click() 
On Error Resume Next 
Application.ScreenUpdating = False 
Dim iTage   As Integer 
Dim dZeit   As Date 
Dim iZeit   As Integer 
Dim iBeit   As Integer 
Dim iposit  As Integer 
Dim iposit2 As Integer 
Dim iWoche As Integer 
   iWoche = TextBox2.value 
   iTage = CInt(TextBox1.value) 
   iposit = InStr(TextBox3.value, ":") 
   iposit2 = InStr(TextBox21.value, ":") 
   If iposit > 0 Then 
      iZeit = (CInt(Left(TextBox3.value, iposit - 1) * 60) + _
             CInt(Right(TextBox3.value, Len(TextBox3.value) - iposit))) 
    Else 
      MsgBox "bitte eine gültige Zeitangabe (hh:mm) eingeben.", _
         48, "   " & Date & "   Hinweis für " & Application.UserName 
      With TextBox2 
         .SetFocus 
         .SelStart = 0 
         .SelLength = Len(.Text) 
      End With 
      Exit Sub 
   End If 
   TextBox6.value = Format(Int(iZeit / iWoche * iTage / 60) + (iZeit / iWoche * iTage / 60 - _
     Int(iZeit / iWoche * iTage / 60)) * 60 / 100, "#0.00") 
   TextBox6.value = Replace(TextBox6.value, ",", ":") 
Dim iHH As Integer 
Dim iMM As Integer 
Dim iDD As Integer 
iHH = GetTextBox6Value 
TextBox24.value = iHH & ":00" 
Sheets("xxxxxx").Unprotect passw 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = False 
Sheets("xxxxxx").Range("D1").value = TextBox24.value 
Sheets("xxxxxx").Range("D2").value = TextBox21.value 
Sheets("xxxxxx").Range("D3").value = TextBox25.value 
TextBox15.value = Sheets("xxxxxx").Range("D4").Text 
TextBox21.value = "" 
TextBox25.value = "" 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = True 
Sheets("xxxxxx").Protect passw 
Application.ScreenUpdating = False 
End Sub 
Private Sub Label231_Click() 
On Error Resume Next 
Application.ScreenUpdating = False 
Dim iTage   As Integer 
Dim dZeit   As Date 
Dim iZeit   As Integer 
Dim iBeit   As Integer 
Dim iposit  As Integer 
Dim iposit2 As Integer 
Dim iWoche As Integer 
   iWoche = TextBox2.value 
   iTage = CInt(TextBox1.value) 
   iposit = InStr(TextBox3.value, ":") 
   iposit2 = InStr(TextBox21.value, ":") 
   If iposit > 0 Then 
      iZeit = (CInt(Left(TextBox3.value, iposit - 1) * 60) + _
             CInt(Right(TextBox3.value, Len(TextBox3.value) - iposit))) 
    Else 
      MsgBox "bitte eine gültige Zeitangabe (hh:mm) eingeben.", _
         48, "   " & Date & "   Hinweis für " & Application.UserName 
      With TextBox2 
         .SetFocus 
         .SelStart = 0 
         .SelLength = Len(.Text) 
      End With 
      Exit Sub 
   End If 
   TextBox6.value = Format(Int(iZeit / iWoche * iTage / 60) + (iZeit / iWoche * iTage / 60 - _
     Int(iZeit / iWoche * iTage / 60)) * 60 / 100, "#0.00") 
   TextBox6.value = Replace(TextBox6.value, ",", ":") 
Dim iHH As Integer 
Dim iMM As Integer 
Dim iDD As Integer 
iHH = GetTextBox6Value 
TextBox24.value = iHH & ":00" 
Sheets("xxxxxx").Unprotect passw 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = False 
Sheets("xxxxxx").Range("D1").value = TextBox24.value 
Sheets("xxxxxx").Range("D2").value = TextBox21.value 
Sheets("xxxxxx").Range("D3").value = TextBox25.value 
TextBox16.value = Sheets("xxxxxx").Range("D4").Text 
TextBox21.value = "" 
TextBox25.value = "" 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = True 
Sheets("xxxxxx").Protect passw 
Application.ScreenUpdating = False 
End Sub 
Private Sub Label232_Click() 
On Error Resume Next 
Application.ScreenUpdating = False 
Dim iTage   As Integer 
Dim dZeit   As Date 
Dim iZeit   As Integer 
Dim iBeit   As Integer 
Dim iposit  As Integer 
Dim iposit2 As Integer 
Dim iWoche As Integer 
   iWoche = TextBox2.value 
   iTage = CInt(TextBox1.value) 
   iposit = InStr(TextBox3.value, ":") 
   iposit2 = InStr(TextBox21.value, ":") 
   If iposit > 0 Then 
      iZeit = (CInt(Left(TextBox3.value, iposit - 1) * 60) + _
             CInt(Right(TextBox3.value, Len(TextBox3.value) - iposit))) 
    Else 
      MsgBox "bitte eine gültige Zeitangabe (hh:mm) eingeben.", _
         48, "   " & Date & "   Hinweis für " & Application.UserName 
      With TextBox2 
         .SetFocus 
         .SelStart = 0 
         .SelLength = Len(.Text) 
      End With 
      Exit Sub 
   End If 
   TextBox6.value = Format(Int(iZeit / iWoche * iTage / 60) + (iZeit / iWoche * iTage / 60 - _
     Int(iZeit / iWoche * iTage / 60)) * 60 / 100, "#0.00") 
   TextBox6.value = Replace(TextBox6.value, ",", ":") 
Dim iHH As Integer 
Dim iMM As Integer 
Dim iDD As Integer 
iHH = GetTextBox6Value 
TextBox24.value = iHH & ":00" 
Sheets("xxxxxx").Unprotect passw 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = False 
Sheets("xxxxxx").Range("D1").value = TextBox24.value 
Sheets("xxxxxx").Range("D2").value = TextBox21.value 
Sheets("xxxxxx").Range("D3").value = TextBox25.value 
TextBox17.value = Sheets("xxxxxx").Range("D4").Text 
TextBox21.value = "" 
TextBox25.value = "" 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = True 
Sheets("xxxxxx").Protect passw 
Application.ScreenUpdating = False 
End Sub 
Private Sub Label233_Click() 
On Error Resume Next 
Application.ScreenUpdating = False 
Dim iTage   As Integer 
Dim dZeit   As Date 
Dim iZeit   As Integer 
Dim iBeit   As Integer 
Dim iposit  As Integer 
Dim iposit2 As Integer 
Dim iWoche As Integer 
   iWoche = TextBox2.value 
   iTage = CInt(TextBox1.value) 
   iposit = InStr(TextBox3.value, ":") 
   iposit2 = InStr(TextBox21.value, ":") 
   If iposit > 0 Then 
      iZeit = (CInt(Left(TextBox3.value, iposit - 1) * 60) + _
             CInt(Right(TextBox3.value, Len(TextBox3.value) - iposit))) 
    Else 
      MsgBox "bitte eine gültige Zeitangabe (hh:mm) eingeben.", _
         48, "   " & Date & "   Hinweis für " & Application.UserName 
      With TextBox2 
         .SetFocus 
         .SelStart = 0 
         .SelLength = Len(.Text) 
      End With 
      Exit Sub 
   End If 
   TextBox6.value = Format(Int(iZeit / iWoche * iTage / 60) + (iZeit / iWoche * iTage / 60 - _
     Int(iZeit / iWoche * iTage / 60)) * 60 / 100, "#0.00") 
   TextBox6.value = Replace(TextBox6.value, ",", ":") 
Dim iHH As Integer 
Dim iMM As Integer 
Dim iDD As Integer 
iHH = GetTextBox6Value 
TextBox24.value = iHH & ":00" 
Sheets("xxxxxx").Unprotect passw 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = False 
Sheets("xxxxxx").Range("D1").value = TextBox24.value 
Sheets("xxxxxx").Range("D2").value = TextBox21.value 
Sheets("xxxxxx").Range("D3").value = TextBox25.value 
TextBox18.value = Sheets("xxxxxx").Range("D4").Text 
TextBox21.value = "" 
TextBox25.value = "" 
Sheets("xxxxxx").Columns("D:D").EntireColumn.Hidden = True 
Sheets("xxxxxx").Protect passw 
Application.ScreenUpdating = False 
End Sub 
Private Sub Label22_Click() 
On Error Resume Next 
Application.ScreenUpdating = False 
ThisWorkbook.Sheets("xxxxxx").Unprotect passw 
Range("E6").Activate 
ActiveCell.value = TextBox7.value 
ActiveCell.Offset(0, 1).value = TextBox8.value 
ActiveCell.Offset(0, 2).value = TextBox9.value 
ActiveCell.Offset(0, 3).value = TextBox10.value 
ActiveCell.Offset(0, 4).value = TextBox11.value 
ActiveCell.Offset(0, 5).value = TextBox12.value 
ActiveCell.Offset(0, 6).value = TextBox13.value 
ActiveCell.Offset(0, 7).value = TextBox14.value 
ActiveCell.Offset(0, 8).value = TextBox15.value 
ActiveCell.Offset(0, 9).value = TextBox16.value 
ActiveCell.Offset(0, 10).value = TextBox17.value 
ActiveCell.Offset(0, 11).value = TextBox18.value 
Application.ScreenUpdating = True 
ThisWorkbook.Sheets("Tabelle1").Protect passw 
Application.Calculate 
End Sub 
Private Sub Label20_Click() 
On Error Resume Next 
Application.ScreenUpdating = False 
ThisWorkbook.Sheets("Tabelle1").Unprotect passw 
Range("E6").Activate 
ActiveCell.value = "" 
ActiveCell.Offset(0, 1).value = "" 
ActiveCell.Offset(0, 2).value = "" 
ActiveCell.Offset(0, 3).value = "" 
ActiveCell.Offset(0, 4).value = "" 
ActiveCell.Offset(0, 5).value = "" 
ActiveCell.Offset(0, 6).value = "" 
ActiveCell.Offset(0, 7).value = "" 
ActiveCell.Offset(0, 8).value = "" 
ActiveCell.Offset(0, 9).value = "" 
ActiveCell.Offset(0, 10).value = "" 
ActiveCell.Offset(0, 11).value = "" 
Application.ScreenUpdating = True 
ThisWorkbook.Sheets("Tabelle1").Protect passw 
End Sub 
Private Sub Label21_Click() 
Dim i As Integer 
For i = 7 To 19 
  Me.Controls("TextBox" & i).value = "" 
  Next i 
End Sub 
Private Sub CommandButton32_Click() 
Unload Me 
End Sub 
Private Sub Label19_Click() 
Dim i1Zeit  As Double 
Dim i2Zeit As Double 
i1Zeit = Val(TextBox7.value) + Val(TextBox8.value) + Val(TextBox9.value) _
+ Val(TextBox10.value) + Val(TextBox11.value) _
+ Val(TextBox12.value) + Val(TextBox13.value) + Val(TextBox14.value) _
+ Val(TextBox15.value) + Val(TextBox16.value) _
+ Val(TextBox17.value) + Val(TextBox18.value) '+ Val(TextBox20.value) 
TextBox19.value = Int(i1Zeit) & ":" & Format((i1Zeit - Int(i1Zeit)) * 60, "00") 
End Sub 
Private Sub CommandButton35_Click() 
On Error Resume Next 
Sheets("xxxxxx").Range("D1").value = TextBox7.value 
Sheets("xxxxxx").Range("D2").value = TextBox21.value 
TextBox7.value = Sheets("xxxxxx").Range("D3").Text 
End Sub 
Private Sub Label221_Click() 
Unload Me 
ThisWorkbook.Unprotect passw 
ThisWorkbook.Sheets("Zeitnachweis").visible = True 
ThisWorkbook.Protect passw 
End Sub 
Private Sub Label220_Click() 
On Error Resume Next 
Dim i As Integer 
  For i = 40 To 195 
  Me.Controls("Label" & i).Caption = "" 
  Next i 
  For i = 212 To 216 
  Me.Controls("Label" & i).Caption = "" 
  Next i 
  For i = 241 To 339 
  Me.Controls("Label" & i).Caption = "" 
  Next i 
End Sub 
Private Sub Label23_Click() 
Unload Me 
End Sub 
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
TextBox3.Text = Format(TextBox3.Text, "00:00") 
End Sub 
Private Sub TextBox20_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
TextBox20.Text = Format(TextBox20.Text, "00:00") 
End Sub 
Private Sub TextBox21_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
TextBox21.Text = Format(TextBox21.Text, "00:00") 
If TextBox25.value <> "" Then 
MsgBox "Sie können ML und ÜZ aus Vormonaten " & _
"nicht gleichzeitig auf den Folgemonat übertragen." & _
vbCrLf & "Ziehen Sie die ÜZ manuell von der ML ab und tragen" & vbCrLf & _
"Sie das Ergebnis ein.", vbExclamation + vbOKOnly, "Eingabefehler" 
TextBox21.Text = "" 
Else 
End If 
End Sub 
Private Sub TextBox25_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
On Error Resume Next 
TextBox25.Text = Format(TextBox25.Text, "00:00") 
If TextBox21.value <> "" Then 
MsgBox "Sie können ML und ÜZ aus Vormonaten " & _
"nicht gleichzeitig auf den Folgemonat übertragen." & _
vbCrLf & "Ziehen Sie die ÜZ manuell von der ML ab und tragen" & vbCrLf & _
"Sie das Ergebnis ein.", vbExclamation + vbOKOnly, "Eingabefehler" 
TextBox25.Text = "" 
Else 
End If 
End Sub 
Private Function GetTextBox6Value() As String 
    Dim iposit As Integer 
    Dim iHH As Integer 
    Dim iMM As Integer 
    Dim value As String 
    iposit = InStr(TextBox6.value, ":") 
    iHH = Val(Left(TextBox6.value, iposit - 1)) 
    iMM = Val(Mid(TextBox6.value, iposit + 1)) 
    value = iHH + IIf(iMM < 30, 0, 1) 
    GetTextBox6Value = Replace(Mid(Str(value), 2), ",", ":") 
Exit Function 
End Function 
Private Sub userform_initialize() 
TextBox6.visible = False 
TextBox24.visible = False 
End Sub 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 
If CloseMode = vbFormControlMenu Then 
    Cancel = True 
End If 
End Sub 
Private Sub zurück() 
Dim i As Integer 
 On Error Resume Next 
  For i = 1 To 30 
  Me.Controls("CommandButton" & i).Enabled = False 
  Next i 
End Sub 

Option Explicit 
Private Sub Label13_Click() 
On Error Resume Next 
Application.ScreenUpdating = False 
ThisWorkbook.Sheets("xxxxxx").Unprotect passw 
Range("E6").Select 
ActiveCell.value = TextBox1.value 
ActiveCell.Offset(0, 1).value = TextBox2.value 
ActiveCell.Offset(0, 2).value = TextBox3.value 
ActiveCell.Offset(0, 3).value = TextBox4.value 
ActiveCell.Offset(0, 4).value = TextBox5.value 
ActiveCell.Offset(0, 5).value = TextBox6.value 
ActiveCell.Offset(0, 6).value = TextBox7.value 
ActiveCell.Offset(0, 7).value = TextBox8.value 
ActiveCell.Offset(0, 8).value = TextBox9.value 
ActiveCell.Offset(0, 9).value = TextBox10.value 
ActiveCell.Offset(0, 10).value = TextBox11.value 
ActiveCell.Offset(0, 11).value = TextBox12.value 
Application.ScreenUpdating = True 
ThisWorkbook.Sheets("xxxxxx").Protect passw 
Unload Me 
End Sub 
Private Sub Label14_Click() 
Unload Me 
Range("A1").Select 
End Sub 
 
Private Sub UserForm_Click() 
 
End Sub 

Option Explicit 
Private Sub CoEnde_Click() 
    Unload Me 
End Sub 
Private Sub CheckBox1_Click() 
On Error Resume Next 
Dim DistAZ As String 
If CheckBox1.value = True Then 
DistAZ = "xxxxxx" 
SaveSetting "xxxxxx", "xxxxxx", "xxxxxx", DistAZ 
Else 
DistAZ = "" 
SaveSetting "xxxxxx", "xxxxxx", "xxxxxx", DistAZ 
End If 
End Sub 
Private Sub Label22_Click() 
Unload Me 
End Sub 
Private Sub userform_initialize() 
On Error Resume Next 
Dim level As String 
Dim DistAZ As String 
DistAZ = GetSetting("xxxxxx", "xxxxxx", "xxxxxx") 
If GetSetting("xxxxxx", "xxxxxx", "xxxxxx") = "xxxxxx" Then CheckBox1.value = True 
With TextBox1 
    .SetFocus 
    .SelStart = 0 
    .SelLength = 0 
    .Locked = True 
End With 
With TextBox2 
    .SetFocus 
    .SelStart = 0 
    .SelLength = 0 
    .Locked = True 
    End With 
End Sub 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 
If CloseMode = vbFormControlMenu Then 
    Cancel = True 
End If 
End Sub 

Private Sub Label4_Click() 
Unload Me 
End Sub 
 

Option Explicit 
Option Private Module 
 Type PeriodStartStop 
    Start As Double 
    Stop_ As Double 
  End Type 
Public Const ComPuterName1 = "xxxxxx" 
Public Const ComPuterName2 = "xxxxxx" 
Public Const passw = "xxxxxx" 
Public objRibbon As IRibbonUI 
Public Sub onload(ribbon As IRibbonUI) 
Set objRibbon = ribbon 
End Sub 
Public Sub visible(control As IRibbonControl, ByRef visible) 
If GetSetting("xxxxxx", "xxxxxx", "xxxxxx") = "xxxxxx" Or (Environ("COMPUTERNAME") _
= ComPuterName1 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Or _
(Environ("COMPUTERNAME") = ComPuterName2 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Then visible = True 
End Sub 
Public Sub visible_SheetZeitnachweis(control As IRibbonControl, ByRef visible) 
If ActiveSheet.Name = "Zeitnachweis" Then visible = True 
End Sub 
Sub getLabelTabsEinAus(control As IRibbonControl, ByRef label) 
label = False 
End Sub 
Sub getVisibleTabsEinAus(control As IRibbonControl, ByRef visible) 
If (Environ("COMPUTERNAME") = ComPuterName1 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Or _
(Environ("COMPUTERNAME") = ComPuterName2 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Then visible = True 
End Sub 
Sub getVisibleAlleMonate(control As IRibbonControl, ByRef visible) 
If (Environ("COMPUTERNAME") = ComPuterName1 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Or _
(Environ("COMPUTERNAME") = ComPuterName2 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Then visible = True 
End Sub 
Sub Eingang(control As IRibbonControl, ByRef visible) 
visible = True 
End Sub 
Sub SeiteDrucken(control As IRibbonControl) 
Application.Dialogs(xlDialogPrint).Show 
End Sub 
Sub Zurücksetzen(control As IRibbonControl) 
Application.EnableCancelKey = xlDisabled 
On Error Resume Next 
ThisWorkbook.Sheets("xxxxxx").Range("F5:F8,F10:F17,F20:F22, K5:K5").ClearContents 
ThisWorkbook.Sheets("xxxxxx").Range("F2345").value = "0" 
Dim DistAZ As String 
Dim DistYear As String 
Dim DistMap As String 
Dim m As String 
m = "" 
DistMap = m 
DistAZ = "" 
DistYear = "" 
DeleteSetting "xxxxxx", "xxxxxx", "xxxxxx" 
DeleteSetting "xxxxxx", "xxxxxx", "xxxxxx" 
DeleteSetting "xxxxxx", "xxxxxx", Environ("USERNAME") 
DeleteSetting "xxxxxx", "xxxxxx", "xxxxxx" 
DeleteSetting "xxxxxx", "xxxxxx", "xxxxxx" 
Sheets("xxxxxx").CommandButton1.visible = False 
End Sub 
Sub Aufräumen(control As IRibbonControl) 
Application.EnableCancelKey = xlDisabled 
Application.CommandBars.ExecuteMso "FileClose" 
End Sub 
Sub Säubern1(control As IRibbonControl) 
Application.EnableCancelKey = xlDisabled 
If ActiveWorkbook.Name <> ThisWorkbook.Name Then GoTo Sicherheitsmeldung 
Sheets("xxxxxx").Range("C12:E743,F12:I743,J12:K743,M12:N743,P12:Q743,T12:T743").ClearContents 
Exit Sub 
Sicherheitsmeldung: 
MsgBox "Die Arbeitsmappe, für welche dieses Makro     " & vbCrLf & _
       "Gültikeit hat, ist nicht im Vordergrund       " & vbCrLf & _
       "aktiv. Daher können Sie dieses Makro derzeit  " & vbCrLf & _
       "nicht nutzen. ", vbOKOnly + vbCritical, "Sicherheitswarnung" 
Application.ScreenUpdating = True 
End Sub 
Sub SpeichernUnter(control As IRibbonControl) 
Application.EnableCancelKey = xlDisabled 
If ActiveWorkbook.Name <> ThisWorkbook.Name Then GoTo Sicherheitsmeldung 
If ThisWorkbook.Sheets("xxxxxx").Range("NKürzel").value = 0 Then GoTo fehlerm: 
Const Lw = "C:\" 
Const Pfad = "ThisWorkbook.Path" 
ActiveWorkbook.SaveAs ThisWorkbook.Sheets("xxxxxx").Range("K7").value 
Exit Sub 
Sicherheitsmeldung: 
MsgBox "Die Arbeitsmappe, für welche dieses Makro     " & vbCrLf & _
       "Gültikeit hat, ist nicht im Vordergrund       " & vbCrLf & _
       "aktiv. Daher können Sie dieses Makro derzeit  " & vbCrLf & _
       "nicht nutzen. ", vbOKOnly + vbCritical, "Sicherheitswarnung" 
Application.ScreenUpdating = True 
Exit Sub 
fehlerm: 
MsgBox "Sie haben kein Namenskürzel unter den      " & vbCrLf & _
       "persönlichen Daten angegeben. Sie können   " & vbCrLf & _
       "daher die Arbeitsmappe nicht unter einem   " & vbCrLf & _
       "anderen Namen speichern. Bitte geben Sie   " & vbCrLf & _
       "erst noch Ihre persönlichen Daten ein. ", vbOKOnly + vbInformation, "Sicherheitshinweis" 
End Sub 
Sub ScrollBar(control As IRibbonControl) 
Application.EnableCancelKey = xlDisabled 
On Error Resume Next 
Application.ScreenUpdating = False 
With ActiveWindow 
    .DisplayHorizontalScrollBar = Not .DisplayHorizontalScrollBar 
    .DisplayVerticalScrollBar = Not .DisplayVerticalScrollBar 
End With 
Application.ScreenUpdating = True 
End Sub 

Option Explicit 
Option Private Module 
Type PeriodStartStop 
    Start As Double 
    Stop_ As Double 
  End Type 
Function lohnma(Kennziffer As String, Ist As Date) As Double 
If Kennziffer = 1 Or Kennziffer = 3 Or Kennziffer = 4 Or Kennziffer = 7 Or _
Kennziffer = 8 Then lohnma = Ist 
End Function 
Function UETM(Art As String, BeginnArbeit As Date, EndeArbeit As Date, Pause As Date) As Double 
If Art = "M" And BeginnArbeit < EndeArbeit Then 
UETM = EndeArbeit - BeginnArbeit - Pause 
ElseIf Art = "M" And BeginnArbeit > EndeArbeit Then 
UETM = (1 - BeginnArbeit) + EndeArbeit - Pause 
Else 
UETM = 0 
End If 
End Function 
Function Schaltjahr(Jahreszahl) 
 If (Jahreszahl Mod 4) = 0 And (Jahreszahl Mod 100) <> 0 Or ((Jahreszahl Mod 400) = 0) Then 
   Schaltjahr = True 
 Else 
   Schaltjahr = False 
 End If 
End Function 
Function UEZM(Kennziffer As String, Arbeitszeit As Date, Schwelle As Date, _
Gutschrift As Date) As Double 
If Kennziffer = 5 And Arbeitszeit > Schwelle Then 
UEZM = Arbeitszeit - Schwelle 
ElseIf Kennziffer = 6 And Arbeitszeit > Schwelle Then 
UEZM = (Arbeitszeit - Schwelle) + ((Arbeitszeit - Schwelle) * 24 * Gutschrift) / 24 
ElseIf Kennziffer = 9 And Arbeitszeit > Schwelle Then 
UEZM = Arbeitszeit - Schwelle 
ElseIf Kennziffer = 10 And Arbeitszeit > Schwelle Then 
UEZM = (Arbeitszeit - Schwelle) + ((Arbeitszeit - Schwelle) * 24 * Gutschrift) / 24 
Else 
UEZM = 0 
End If 
End Function 
Function lohnnormal(Kennziffer As String, Ist As Date, Soll As Date) As Double 
If Kennziffer = 1 And Ist >= Soll Then 
lohnnormal = Soll 
ElseIf Kennziffer = 1 And Ist < Soll Then 
lohnnormal = Ist 
ElseIf Kennziffer = 3 And Ist >= Soll Then 
lohnnormal = Soll 
ElseIf Kennziffer = 3 And Ist < Soll Then 
lohnnormal = Ist 
ElseIf Kennziffer = 4 And Ist >= Soll Then 
lohnnormal = Soll 
ElseIf Kennziffer = 4 And Ist < Soll Then 
lohnnormal = Ist 
ElseIf Kennziffer = 7 And Ist >= Soll Then 
lohnnormal = Soll 
ElseIf Kennziffer = 7 And Ist < Soll Then 
lohnnormal = Ist 
ElseIf Kennziffer = 8 And Ist >= Soll Then 
lohnnormal = Soll 
ElseIf Kennziffer = 8 And Ist < Soll Then 
lohnnormal = Ist 
ElseIf Kennziffer = 9 And Ist >= Soll Then 
lohnnormal = Soll 
ElseIf Kennziffer = 9 And Ist < Soll Then 
lohnnormal = Ist 
ElseIf Kennziffer = 10 And Ist >= Soll Then 
lohnnormal = Soll 
ElseIf Kennziffer = 10 And Ist < Soll Then 
lohnnormal = Ist 
Else 
lohnnormal = 0 
End If 
End Function 
Function lohnzeit(Kennziffer As String, Ist As Date, Soll As Date) As Double 
If Kennziffer = 6 Or Kennziffer = 5 Then 
lohnzeit = 0 
ElseIf Kennziffer = 1 And Ist > Soll Then 
lohnzeit = Ist - Soll 
ElseIf Kennziffer = 2 And Ist > Soll Then 
lohnzeit = Ist - Soll 
Else 
lohnzeit = 0 
End If 
End Function 
Function fta(Art As String, SpalteZwei As String, SpalteG As Date, SpalteH As Date, _
SpalteAQ As Date, SpalteAS As Date, SpalteAU As Date) As Double 'Feiertag1 
If Art = "M" Or Art = "U" Or Art = "K" Then 
fta = 0 
ElseIf SpalteZwei = "x" Then 
 If SpalteG <= SpalteH Then 
  fta = (SpalteH - SpalteG) - (SpalteAQ + SpalteAS + SpalteAU) 
  Else 
  fta = (1 - SpalteG) - (SpalteAQ + SpalteAS + SpalteAU) 
  End If 
Else 
fta = 0 
End If 
End Function 
Function ftb(Art As String, SpalteDrei As String, SpalteH As Date, SpalteAR As Date, _
SpalteAT As Date, SpalteAV As Date) As Double ' Feiertag2 
If Art = "M" Or Art = "U" Or Art = "K" Then 
ftb = 0 
ElseIf SpalteDrei = "x" Then 
 ftb = (SpalteH - 0) - (SpalteAR + SpalteAT + SpalteAV) 
Else 
 ftb = 0 
End If 
End Function 
Function sonntag(Art As String, Datum As Date, BeginnArbeit As Date, EndeArbeit As Date, _
Ist As Date, PauseEinsTag As Date, PauseZweiTag As Date, PauseDreiTag As Date) As Double 
If Art = "M" Or Art = "U" Or Art = "K" Then 
sonntag = 0 
ElseIf Weekday(Datum, vbMonday) = 7 Then 
   If BeginnArbeit <= EndeArbeit Then 
     sonntag = Ist 
     Else 
    sonntag = (1 - BeginnArbeit) - (PauseEinsTag + PauseZweiTag + PauseDreiTag) 
     End If 
Else 
sonntag = 0 
End If 
End Function 
Function PEins(BeginnArbeit As Date, EndeArbeit As Date, BeginnPausen As Date, _
EndePausen As Date) As Double 
On Error Resume Next 
If BeginnArbeit > EndeArbeit And BeginnPausen > EndePausen Then 
PEins = 1 - BeginnPausen 
Else 
PEins = 0 
End If 
End Function 
Function PZwei(BeginnArbeit As Date, EndeArbeit As Date, EndePausen As Date, _
BeginnPausen As Date) As Double 
If BeginnArbeit > EndeArbeit And EndePausen > EndeArbeit Then 
PZwei = EndePausen - BeginnPausen 
Else 
PZwei = 0 
End If 
End Function 
Function PDrei(BeginnArbeit As Date, EndeArbeit As Date, BeginnPausen As Date, _
EndePausen As Date) As Double 
If BeginnArbeit < EndeArbeit And BeginnPausen < EndePausen Then 
PDrei = EndePausen - BeginnPausen 
Else 
PDrei = 0 
End If 
End Function 
Function PVier(BeginnArbeit As Date, EndeArbeit As Date, BeginnPausen As Date, _
EndePausen As Date) As Double 
If BeginnArbeit > EndeArbeit And BeginnPausen > EndePausen Then 
PVier = EndePausen - 0 
Else 
PVier = 0 
End If 
End Function 
Function PFünf(BeginnArbeit As Date, EndeArbeit As Date, BeginnPausen As Date, _
EndePausen As Date) As Double 
If BeginnArbeit > EndeArbeit And BeginnPausen < EndePausen Then 
PFünf = EndePausen - BeginnPausen 
Else 
PFünf = 0 
End If 
End Function 
Function PSechs(BeginnArbeit As Date, EndeArbeit As Date, BeginnPausen As Date, _
EndePausen As Date) As Double 
If BeginnArbeit < BeginnPausen And EndeArbeit < EndePausen Then 
PSechs = EndePausen - BeginnPausen 
Else 
PSechs = 0 
End If 
End Function 
Function Urlaub(Art As String, Url As Date) As Double 
If Art = "U" Then 
Urlaub = Url 
Else 
Urlaub = 0 
End If 
End Function 
Function IstZeit(Art As String, BeginnArbeit As Date, EndeArbeit As Date, _
PauseGesamt As Date, Urlaub As Date) As Double 
If Art = "M" Or Art = "R" Or Art = "U" Then 
IstZeit = 0 
ElseIf BeginnArbeit <= EndeArbeit Then 
IstZeit = (EndeArbeit - BeginnArbeit) - PauseGesamt 
Else 
IstZeit = (1 - BeginnArbeit + EndeArbeit) - PauseGesamt 
End If 
End Function 
Function UEMZeit(Art As String, Ist As Date, Soll As Date) As Double 
If Art = "M" Or Art = "R" Or Art = "K" Or Art = "U" Then 
UEMZeit = 0 
Else 
UEMZeit = (Ist - Soll) 
End If 
End Function 
Function ZeitGut(Kennziffer As String, Ist As Date, Soll As Date, FaktorGutschrift As Date) As Double 
If Kennziffer = 6 Or Kennziffer = 5 Then 
ZeitGut = 0 
ElseIf Kennziffer <> 3 Then 
ZeitGut = 0 
ElseIf Ist > Soll Then 
ZeitGut = ((Ist - Soll) * 24) * FaktorGutschrift / 24 
Else 
ZeitGut = 0 
End If 
End Function 
Function FZK(Kennziffer As String, Ist As Date, Soll As Date, SpalteX As Date) As Double 
If Kennziffer = 6 Or Kennziffer = 5 Then 
FZK = 0 
ElseIf Kennziffer = 3 And Ist > Soll Then 
FZK = (Ist - Soll) + SpalteX 
ElseIf Kennziffer = 7 And Ist > Soll Then 
FZK = Ist - Soll 
Else 
FZK = 0 
End If 
End Function 
Function SPause(BeginnPause As Date, EndePause As Date) As Double 
If BeginnPause <= EndePause Then 
SPause = EndePause - BeginnPause 
Else 
SPause = (1 - BeginnPause) + EndePause 
End If 
End Function 
Function samstags(Art As String, samstag As Date, BeginnArbeit As Date, _
EndeArbeit As Date, BeginnPauseEins As Date, EndePauseEins As Date, _
BeginnPauseZwei As Date, EndePauseZwei As Date, BeginnPauseDrei As Date, EndePauseDrei As Date, _
    Optional ShiftStart As Date, _
    Optional ShiftEnd As Date) As Double 
    On Error Resume Next 
    Dim i As Long 
    Dim j As Long 
    Dim Arbeit As Double 
    Dim PauseEins As Double 
    Dim PauseZwei As Double 
    Dim PauseDrei As Double 
    Dim Shift() As PeriodStartStop 
    Dim WorkedArbeit() As PeriodStartStop 
    Dim WorkedPauseEins() As PeriodStartStop 
    Dim WorkedPauseZwei() As PeriodStartStop 
    Dim WorkedPauseDrei() As PeriodStartStop 
Rem Kommen und Gehen 
GetPeriods CDbl(BeginnArbeit), CDbl(EndeArbeit), WorkedArbeit() 
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift() 
    Arbeit = 0 
    For i = 0 To Ubound(WorkedArbeit()) 
      For j = 0 To Ubound(Shift()) 
        Arbeit = Arbeit + GetOverlap(WorkedArbeit(i), Shift(j)) 
      Next j 
    Next i 
Rem Gehen und Kommen Pause 1 
GetPeriods CDbl(BeginnPauseEins), CDbl(EndePauseEins), WorkedPauseEins() 
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift() 
    PauseEins = 0 
    For i = 0 To Ubound(WorkedPauseEins()) 
      For j = 0 To Ubound(Shift()) 
       PauseEins = PauseEins + GetOverlap(WorkedPauseEins(i), Shift(j)) 
      Next j 
    Next i 
Rem Gehen und Kommen Pause 2 
GetPeriods CDbl(BeginnPauseZwei), CDbl(EndePauseZwei), WorkedPauseZwei() 
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift() 
    PauseZwei = 0 
    For i = 0 To Ubound(WorkedPauseZwei()) 
      For j = 0 To Ubound(Shift()) 
        PauseZwei = PauseZwei + GetOverlap(WorkedPauseZwei(i), Shift(j)) 
      Next j 
    Next i 
Rem Gehen und Kommen Pause 3 
GetPeriods CDbl(BeginnPauseDrei), CDbl(EndePauseDrei), WorkedPauseDrei() 
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift() 
   PauseDrei = 0 
    For i = 0 To Ubound(WorkedPauseDrei()) 
      For j = 0 To Ubound(Shift()) 
        PauseDrei = PauseDrei + GetOverlap(WorkedPauseDrei(i), Shift(j)) 
      Next j 
    Next i 
If Art = "M" Or Art = "U" Or Art = "K" Then 
samstags = 0 
ElseIf Weekday(samstag, vbMonday) = 6 Then 
samstags = (Round(Arbeit * 24, 5) - (Round(PauseEins * 24, 5) + Round(PauseZwei * 24, 5) _
+ Round(PauseDrei * 24, 5))) / 24 
Else 
samstags = 0 
End If 
End Function 
Function ZeitR(Art As String, BeginnArbeit As Date, EndeArbeit As Date, _
BeginnPauseEins As Date, EndePauseEins As Date, BeginnPauseZwei As Date, EndePauseZwei As Date, _
BeginnPauseDrei As Date, EndePauseDrei As Date, _
    Optional ShiftStart As Date, _
    Optional ShiftEnd As Date) As Double 
    On Error Resume Next 
    Dim i As Long 
    Dim j As Long 
    Dim Arbeit As Double 
    Dim PauseEins As Double 
    Dim PauseZwei As Double 
    Dim PauseDrei As Double 
    Dim Shift() As PeriodStartStop 
    Dim WorkedArbeit() As PeriodStartStop 
    Dim WorkedPauseEins() As PeriodStartStop 
    Dim WorkedPauseZwei() As PeriodStartStop 
    Dim WorkedPauseDrei() As PeriodStartStop 
Rem Kommen und Gehen 
GetPeriods CDbl(BeginnArbeit), CDbl(EndeArbeit), WorkedArbeit() 
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift() 
    Arbeit = 0 
    For i = 0 To Ubound(WorkedArbeit()) 
      For j = 0 To Ubound(Shift()) 
        Arbeit = Arbeit + GetOverlap(WorkedArbeit(i), Shift(j)) 
      Next j 
    Next i 
Rem Gehen und Kommen Pause 1 
GetPeriods CDbl(BeginnPauseEins), CDbl(EndePauseEins), WorkedPauseEins() 
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift() 
    PauseEins = 0 
    For i = 0 To Ubound(WorkedPauseEins()) 
      For j = 0 To Ubound(Shift()) 
       PauseEins = PauseEins + GetOverlap(WorkedPauseEins(i), Shift(j)) 
      Next j 
    Next i 
Rem Gehen und Kommen Pause 2 
GetPeriods CDbl(BeginnPauseZwei), CDbl(EndePauseZwei), WorkedPauseZwei() 
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift() 
    PauseZwei = 0 
    For i = 0 To Ubound(WorkedPauseZwei()) 
      For j = 0 To Ubound(Shift()) 
        PauseZwei = PauseZwei + GetOverlap(WorkedPauseZwei(i), Shift(j)) 
      Next j 
    Next i 
Rem Gehen und Kommen Pause 3 
GetPeriods CDbl(BeginnPauseDrei), CDbl(EndePauseDrei), WorkedPauseDrei() 
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift() 
   PauseDrei = 0 
    For i = 0 To Ubound(WorkedPauseDrei()) 
      For j = 0 To Ubound(Shift()) 
        PauseDrei = PauseDrei + GetOverlap(WorkedPauseDrei(i), Shift(j)) 
      Next j 
    Next i 
If Art = "M" Or Art = "U" Or Art = "K" Then 
ZeitR = 0 
Else 
ZeitR = (Round(Arbeit * 24, 5) - (Round(PauseEins * 24, 5) + Round(PauseZwei * 24, 5) _
+ Round(PauseDrei * 24, 5))) / 24 
End If 
End Function 
Private Sub GetPeriods(ByVal t1 As Double, ByVal t2 As Double, _
    Period() As PeriodStartStop) 
    t1 = t1 - Int(t1) 
    t2 = t2 - Int(t2) 
    If t1 <= t2 Then 
      Redim Period(0 To 0) 
      Period(0).Start = t1 
      Period(0).Stop_ = t2 
    Else 
      Redim Period(0 To 1) 
      Period(0).Start = t1 
      Period(0).Stop_ = 1 
      Period(1).Start = 0 
      Period(1).Stop_ = t2 
    End If 
  End Sub 
Private Function GetOverlap(Period1 As PeriodStartStop, _
    Period2 As PeriodStartStop) As Double 
    Dim t1 As Double 
    Dim t2 As Double 
    If Period1.Start >= Period2.Start Then 
      t1 = Period1.Start 
    Else 
      t1 = Period2.Start 
    End If 
    If Period1.Stop_ <= Period2.Stop_ Then 
      t2 = Period1.Stop_
    Else 
      t2 = Period2.Stop_
    End If 
    t2 = t2 - t1 
    If t2 < 0 Then t2 = 0 
    GetOverlap = t2 
  End Function 

Option Explicit 
Option Private Module 
Sub AlleMonateEin(control As IRibbonControl) 
Application.EnableCancelKey = xlDisabled 
If ActiveSheet.Name <> "xxxxxx" Then GoTo Fehler 
On Error Resume Next 
If (Environ("COMPUTERNAME") = ComPuterName1 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Or _
(Environ("COMPUTERNAME") = ComPuterName2 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Then GoTo Anfang 
MsgBox "Sie haben nicht die notwendige Berechtigung      " & vbCrLf & _
       "zum Ausführen des Vorgangs. Dieses Makro ist     " & vbCrLf & _
       "ist dem Autor vorbehalten." & vbCrLf & vbCrLf & _
       "              Vorgang abgebrochen.               ", vbExclamation + vbOKOnly, _
       " *** Hinweis des Autors *** " 
    Exit Sub 
Anfang: 
Application.EnableCancelKey = xlDisabled 
Application.ScreenUpdating = False 
ActiveSheet.Unprotect passw 
Range("E8").FormulaR1C1 = "" 
Range("E8").FormulaR1C1 = "" 
Rows("8:745").EntireRow.Hidden = False 
ActiveWindow.SmallScroll Down:=-1234 
Rows("746:1048576").EntireRow.Hidden = True 
ActiveWindow.SmallScroll Down:=-1234 
ActiveSheet.Protect passw 
Application.ScreenUpdating = True 
Exit Sub 
Fehler: 
MsgBox "Sie befinden sich nicht im Blatt xxxxxx." & vbCrLf & _
       "Der Vorgang wurde abgebrochen.", vbOKOnly + vbExclamation, "Warnung" 
End Sub 
Sub JanuarEin(control As IRibbonControl) 
On Error Resume Next 
Application.EnableCancelKey = xlDisabled 
Application.ScreenUpdating = False 
ActiveSheet.Unprotect passw 
Range("E8").FormulaR1C1 = "=DATE(datum1,1,1)" 
Rows("12:744").EntireRow.Hidden = True 
Rows("12:73").EntireRow.Hidden = False 
ActiveWindow.SmallScroll Down:=-1234 
ActiveSheet.Protect passw 
Application.ScreenUpdating = True 
End Sub 
Sub FebruarEin(control As IRibbonControl) 
On Error Resume Next 
Application.EnableCancelKey = xlDisabled 
Application.ScreenUpdating = False 
ActiveSheet.Unprotect passw 
Range("E8").FormulaR1C1 = "=DATE(datum1,2,1)" 
Rows("12:744").EntireRow.Hidden = True 
Rows("74:131").EntireRow.Hidden = False 
ActiveWindow.LargeScroll Down:=-1234 
ActiveSheet.Protect passw 
Application.ScreenUpdating = True 
End Sub 
Sub MärzEin(control As IRibbonControl) 
On Error Resume Next 
Application.EnableCancelKey = xlDisabled 
Application.ScreenUpdating = False 
ActiveSheet.Unprotect passw 
Range("E8").FormulaR1C1 = "=DATE(datum1,3,1)" 
Rows("12:744").EntireRow.Hidden = True 
Rows("132:193").EntireRow.Hidden = False 
ActiveWindow.LargeScroll Down:=-1234 
ActiveSheet.Protect passw 
Application.ScreenUpdating = True 
End Sub 
Sub AprilEin(control As IRibbonControl) 
On Error Resume Next 
Application.EnableCancelKey = xlDisabled 
Application.ScreenUpdating = False 
ActiveSheet.Unprotect passw 
Range("E8").FormulaR1C1 = "=DATE(datum1,4,1)" 
Rows("12:744").EntireRow.Hidden = True 
Rows("194:253").EntireRow.Hidden = False 
ActiveWindow.LargeScroll Down:=-1234 
ActiveSheet.Protect passw 
Application.ScreenUpdating = True 
End Sub 
Sub MaiEin(control As IRibbonControl) 
On Error Resume Next 
Application.EnableCancelKey = xlDisabled 
Application.ScreenUpdating = False 
ActiveSheet.Unprotect passw 
Range("E8").FormulaR1C1 = "=DATE(datum1,5,1)" 
Rows("12:744").EntireRow.Hidden = True 
Rows("254:315").EntireRow.Hidden = False 
ActiveWindow.LargeScroll Down:=-1234 
ActiveSheet.Protect passw 
Application.ScreenUpdating = True 
End Sub 
Sub JuniEin(control As IRibbonControl) 
On Error Resume Next 
Application.EnableCancelKey = xlDisabled 
Application.ScreenUpdating = False 
ActiveSheet.Unprotect passw 
Range("E8").FormulaR1C1 = "=DATE(datum1,6,1)" 
Rows("12:744").EntireRow.Hidden = True 
Rows("316:375").EntireRow.Hidden = False 
ActiveWindow.LargeScroll Down:=-1234 
ActiveSheet.Protect passw 
Application.ScreenUpdating = True 
End Sub 
Sub JuliEin(control As IRibbonControl) 
On Error Resume Next 
Application.EnableCancelKey = xlDisabled 
Application.ScreenUpdating = False 
ActiveSheet.Unprotect passw 
Range("E8").FormulaR1C1 = "=DATE(datum1,7,1)" 
Rows("12:744").EntireRow.Hidden = True 
Rows("376:437").EntireRow.Hidden = False 
ActiveWindow.LargeScroll Down:=-1234 
ActiveSheet.Protect passw 
Application.ScreenUpdating = True 
End Sub 
Sub AugustEin(control As IRibbonControl) 
On Error Resume Next 
Application.EnableCancelKey = xlDisabled 
Application.ScreenUpdating = False 
ActiveSheet.Unprotect passw 
Range("E8").FormulaR1C1 = "=DATE(datum1,8,1)" 
Rows("12:744").EntireRow.Hidden = True 
Rows("438:499").EntireRow.Hidden = False 
ActiveWindow.LargeScroll Down:=-1234 
ActiveSheet.Protect passw 
Application.ScreenUpdating = True 
End Sub 
Sub SeptemberEin(control As IRibbonControl) 
On Error Resume Next 
Application.EnableCancelKey = xlDisabled 
Application.ScreenUpdating = False 
ActiveSheet.Unprotect passw 
Range("E8").FormulaR1C1 = "=DATE(datum1,9,1)" 
Rows("12:744").EntireRow.Hidden = True 
Rows("500:559").EntireRow.Hidden = False 
ActiveWindow.LargeScroll Down:=-1234 
ActiveSheet.Protect passw 
Application.ScreenUpdating = True 
End Sub 
Sub OktoberEin(control As IRibbonControl) 
On Error Resume Next 
Application.EnableCancelKey = xlDisabled 
Application.ScreenUpdating = False 
ActiveSheet.Unprotect passw 
Range("E8").FormulaR1C1 = "=DATE(datum1,10,1)" 
Rows("12:744").EntireRow.Hidden = True 
Rows("560:621").EntireRow.Hidden = False 
ActiveWindow.LargeScroll Down:=-1234 
ActiveSheet.Protect passw 
Application.ScreenUpdating = True 
End Sub 
Sub NovemberEin(control As IRibbonControl) 
On Error Resume Next 
Application.EnableCancelKey = xlDisabled 
Application.ScreenUpdating = False 
ActiveSheet.Unprotect passw 
Range("E8").FormulaR1C1 = "=DATE(datum1,11,1)" 
Rows("12:744").EntireRow.Hidden = True 
Rows("622:681").EntireRow.Hidden = False 
ActiveWindow.LargeScroll Down:=-1234 
ActiveSheet.Protect passw 
Application.ScreenUpdating = True 
End Sub 
Sub DezemberEin(control As IRibbonControl) 
On Error Resume Next 
Application.EnableCancelKey = xlDisabled 
Application.ScreenUpdating = False 
ActiveSheet.Unprotect passw 
Range("E8").FormulaR1C1 = "=DATE(datum1,12,1)" 
Rows("12:744").EntireRow.Hidden = True 
Rows("682:743").EntireRow.Hidden = False 
ActiveWindow.LargeScroll Down:=-1234 
ActiveSheet.Protect passw 
Application.ScreenUpdating = True 
End Sub 
 

Option Explicit 
Option Private Module 
Private Sub Feiertag(control As IRibbonControl) 
ThisWorkbook.Sheets("xxxxxx").Activate 
End Sub 
Sub EinstellEin(control As IRibbonControl) 
ThisWorkbook.Sheets("xxxxxx").Activate 
ActiveWindow.LargeScroll Down:=-1234 
End Sub 
Sub BlattArbeit(control As IRibbonControl) 
If Sheets("xxxxxx").visible = xlVeryHidden Then GoTo Fehler 
Sheets("xxxxxx").Activate 
Exit Sub 
Fehler: 
MsgBox "Bitte vervollständigen Sie erst Ihre " & vbCrLf & _
       "persönlichen Daten. Ohne diese Angaben " & vbCrLf & _
       "können Sie die Arbeitsmappe nicht nutzen.", vbOKOnly + vbExclamation, "Warnung" 
End Sub 
Sub PlanAus(control As IRibbonControl) 
Application.EnableCancelKey = xlDisabled 
If Sheets("xxxxxx").visible = xlVeryHidden Then GoTo Fehler 
Sheets("xxxxxx").Activate 
Exit Sub 
Fehler: 
MsgBox "Bitte vervollständigen Sie erst Ihre " & vbCrLf & _
       "persönlichen Daten. Ohne diese Angaben " & vbCrLf & _
       "können Sie die Arbeitsmappe nicht nutzen.", vbOKOnly + vbExclamation, "Warnung" 
End Sub 
Private Sub Arbeitszeiten(control As IRibbonControl) 
On Error Resume Next 
Application.ScreenUpdating = False 
ThisWorkbook.Sheets("xxxxxx").Activate 
ThisWorkbook.Sheets("xxxxxx").Unprotect passw 
ActiveSheet.ScrollArea = "" 
Columns("A:AA").EntireColumn.Hidden = False 
Range("A1").Select 
Columns("W:W").EntireColumn.Hidden = True 
Columns("AB:AY").EntireColumn.Hidden = True 
ActiveWindow.SmallScroll ToRight:=-35 
ThisWorkbook.Sheets("xxxxxx").Protect passw 
Application.ScreenUpdating = True 
End Sub 
Sub Zuschläge(control As IRibbonControl) 
On Error Resume Next 
Application.ScreenUpdating = False 
ThisWorkbook.Sheets("xxxxxx").Activate 
ThisWorkbook.Sheets("xxxxxx").Unprotect passw 
Columns("A:AY").EntireColumn.Hidden = False 
Columns("A:AA").EntireColumn.Hidden = True 
Columns("AS:AX").EntireColumn.Hidden = True 
ActiveWindow.SmallScroll ToRight:=25 
ActiveWindow.SmallScroll Down:=-1000 
Range("AB7").Select 
ThisWorkbook.Sheets("xxxxxx").Protect passw 
ActiveWindow.SmallScroll ToRight:=-25 
ActiveWindow.SmallScroll Down:=-3768 
Application.ScreenUpdating = True 
End Sub 
Sub box(control As IRibbonControl) 
Application.EnableCancelKey = xlDisabled 
On Error Resume Next 
Dim Excelversion As Byte 
If (Environ("COMPUTERNAME") = ComPuterName1 And GetSetting("xxxxxx", _
"xxxxxx", "xxxxxx") = GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Or _
(Environ("COMPUTERNAME") = ComPuterName2 And GetSetting("xxxxxx", _
"AZTab01", "xxxxxx") = GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Then GoTo Fehler 
MsgBox "Sie haben nicht die notwendige Berechtigung      " & vbCrLf & _
     "zum Ausführen des Vorgangs. Dieses Makro ist     " & vbCrLf & _
       "ist dem Autor vorbehalten." & vbCrLf & vbCrLf & _
      "              Vorgang abgebrochen.               ", vbExclamation + vbOKOnly, _
      " *** Hinweis des Autors *** " 
Exit Sub 
Fehler: 
Dim blatt As Object 
Sheets("xxxxxx").Activate 
If ThisWorkbook.Sheets("xxxxxx").Columns("AS:AX").EntireColumn.Hidden = True Then 
Application.ScreenUpdating = False 
ActiveWindow.DisplayWorkbookTabs = True 
For Each blatt In ActiveWorkbook.Sheets 
blatt.Activate 
blatt.Unprotect passw 
blatt.ScrollArea = "" 
ActiveWindow.DisplayHeadings = True 
Next blatt 
Sheets("xxxxxx").Activate 
Columns("A:AY").EntireColumn.Hidden = False 
Columns("W:W").EntireColumn.Hidden = True 
Rows("8:745").EntireRow.Hidden = False 
ActiveWindow.SmallScroll Down:=-1234 
With ActiveWindow 
    .DisplayHorizontalScrollBar = True 
    .DisplayVerticalScrollBar = True 
End With 
Application.ScreenUpdating = True 
Else 
Application.ScreenUpdating = False 
Sheets("xxxxx").ScrollArea = "A1:C27" 
Sheets("xxxxxx").ScrollArea = "A1:W22" 
Sheets("xxxxxx").ScrollArea = "A1:Y900" 
Sheets("xxxxxx").Activate 
ThisWorkbook.Sheets("xxxxxx").Columns("AB:AY").EntireColumn.Hidden = True 
Range("A12").Select 
Range("E8").FormulaR1C1 = "=DATE(datum1,1,1)" 
Rows("74:744").EntireRow.Hidden = True 
ActiveWindow.SmallScroll Down:=-1234 
ActiveWindow.SmallScroll ToRight:=-236 
For Each blatt In ActiveWorkbook.Sheets 
blatt.Activate 
blatt.Protect passw 
ActiveWindow.DisplayHeadings = False 
Next blatt 
ActiveWindow.DisplayWorkbookTabs = False 
Sheets("xxxxxx").Activate 
With ActiveWindow 
    .DisplayHorizontalScrollBar = False 
    .DisplayVerticalScrollBar = False 
End With 
Application.ScreenUpdating = True 
End If 
End Sub 

Option Explicit 
Option Private Module 
Private Sub Week_end() 
Application.EnableCancelKey = xlDisabled 
Dim cell As Object 
On Error Resume Next 
Dim Zeile As Range 
For Each cell In Worksheets("xxxxxx").Range("B13:B743") 
If Weekday(cell, vbMonday) = 7 Then 
cell.Font.ColorIndex = 3 
ElseIf Weekday(cell, vbMonday) = 6 Then 
cell.Font.ColorIndex = 5 
Else 
cell.Font.ColorIndex = 0 
End If 
Next cell 
End Sub 
Private Sub Week_end2() 
Application.EnableCancelKey = xlDisabled 
Dim cell As Object 
On Error Resume Next 
Dim Zeile As Range 
For Each cell In Worksheets("xxxxxx").Range("AB13:AB743") 
If Weekday(cell, vbMonday) = 7 Then 
cell.Font.ColorIndex = 3 
ElseIf Weekday(cell, vbMonday) = 6 Then 
cell.Font.ColorIndex = 5 
Else 
cell.Font.ColorIndex = 0 
End If 
Next cell 
End Sub 
Sub Aendern() 
Application.EnableCancelKey = xlDisabled 
On Error Resume Next 
Application.ScreenUpdating = False 
Sheets("xxxxxx").Unprotect passw 
Week_end 
Week_day 
Week_frei 
Week_end2 
Week_day2 
Sheets("xxxxxx").Protect passw 
Application.ScreenUpdating = True 
End Sub 
Private Sub Week_day() 
Application.EnableCancelKey = xlDisabled 
Dim cell As Object 
On Error Resume Next 
Dim Zeile As Range 
For Each cell In Worksheets("xxxxxx").Range("B13:B743") 
If cell.value = Sheets("xxxxxx").Range("A1").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A2").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A3").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A4").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A5").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A6").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A7").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A8").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A9").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A10").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A11").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A12").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A13").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A14").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A15").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A16").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A17").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A18").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A19").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A20").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A21").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A22").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A23").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A24").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A25").value Then 
cell.Font.ColorIndex = 3 
Else 
End If 
Next cell 
End Sub 
Private Sub Week_day2() 
Application.EnableCancelKey = xlDisabled 
Dim cell As Object 
On Error Resume Next 
Dim Zeile As Range 
For Each cell In Worksheets("xxxxxx").Range("AB13:AB743") 
If cell.value = Sheets("xxxxxx").Range("A1").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A2").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A3").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A4").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A5").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A6").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A7").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A8").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A9").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A10").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A11").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A12").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A13").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A14").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A15").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A16").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A17").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A18").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A19").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A20").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A21").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A22").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A23").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A24").value Then 
cell.Font.ColorIndex = 3 
ElseIf cell.value = Sheets("xxxxxx").Range("A25").value Then 
cell.Font.ColorIndex = 3 
Else 
End If 
Next cell 
End Sub 
Private Sub Week_frei() 
Application.EnableCancelKey = xlDisabled 
Dim cell As Object 
On Error Resume Next 
Dim Zeile As Range 
For Each cell In Worksheets("xxxxxx").Range("B13:B743") 
If cell.value = Sheets("xxxxxx").Range("A1").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A2").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A3").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A4").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A5").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A6").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A7").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A8").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A9").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A10").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A11").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A12").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A13").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A14").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A15").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A16").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A17").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A18").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A19").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A20").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A21").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A22").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A23").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A24").value Then 
cell.Offset(0, 21).value = "F" 
ElseIf cell.value = Sheets("xxxxxx").Range("A25").value Then 
cell.Offset(0, 21).value = "F" 
Else 
cell.Offset(0, 21).value = "" 
End If 
Next cell 
End Sub 

Option Explicit 
Option Private Module 
Sub DateiSchützen(control As IRibbonControl) 
'On Error GoTo Fehler 
Dim s As String 
Application.DisplayAlerts = False 
s = InputBox("Bitte geben Sie das Dateikennwort ein") 
If s = "" Then GoTo Fehler 
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, Password:=s, WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False 
MsgBox "Die Arbeitsmappe wurde mit dem Kennwort " & s & " geschützt", _
vbOKOnly + vbInformation, "Hinweis" 
Application.DisplayAlerts = True 
Exit Sub 
Fehler: 
Application.DisplayAlerts = True 
MsgBox "Das Dateikennwort konnte nicht erstellt werden", vbOKOnly + vbExclamation, "Warnung" 
End Sub 
Sub DateiEntschützen(control As IRibbonControl) 
On Error GoTo Fehler 
Dim s As String 
Application.DisplayAlerts = False 
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False 
MsgBox "Der Dateischutz wurde erfolgreich aufgehoben.", vbOKOnly + vbInformation, "Hinweis" 
Application.DisplayAlerts = True 
Exit Sub 
Fehler: 
Application.DisplayAlerts = True 
MsgBox "Der Dateischutz konnte nicht aufgehoben werden.", vbOKOnly + vbExclamation, "Warnung" 
End Sub 
Sub BlattSchutzAus(control As IRibbonControl) 
Application.EnableCancelKey = xlDisabled 
If ActiveSheet.ProtectContents = False Then Exit Sub 
If (Environ("COMPUTERNAME") = ComPuterName1 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Or _
(Environ("COMPUTERNAME") = ComPuterName2 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Then 
Application.ScreenUpdating = False 
Dim blatt As Object 
For Each blatt In ActiveWorkbook.Sheets 
blatt.Unprotect passw 
blatt.ScrollArea = "" 
Next blatt 
Application.ScreenUpdating = True 
Else 
MsgBox "Sie haben nicht die notwendige Berechtigung      " & vbCrLf & _
       "zum Ausführen des Vorgangs. Dieses Makro ist     " & vbCrLf & _
       "ist dem Autor vorbehalten." & vbCrLf & vbCrLf & _
       "              Vorgang abgebrochen.               ", vbExclamation + vbOKOnly, _
       " *** Hinweis des Autors *** " 
End If 
End Sub 
Sub BlattSchutzEin(control As IRibbonControl) 
Application.EnableCancelKey = xlDisabled 
If ActiveSheet.ProtectContents = True Then Exit Sub 
If (Environ("COMPUTERNAME") = ComPuterName1 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Or _
(Environ("COMPUTERNAME") = ComPuterName2 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Then 
Application.ScreenUpdating = False 
Sheets("xxxxxx").ScrollArea = "A1:C27" 
Sheets("xxxxxx").ScrollArea = "A1:W22" 
Sheets("xxxxxx").ScrollArea = "A1:AF1229" 
Dim blatt As Object 
For Each blatt In ActiveWorkbook.Sheets 
With blatt 
.Protect passw 
.EnableSelection = xlUnlockedCells 
End With 
Next blatt 
Application.ScreenUpdating = True 
Else 
MsgBox "Sie haben nicht die notwendige Berechtigung      " & vbCrLf & _
       "zum Ausführen des Vorgangs. Dieses Makro ist     " & vbCrLf & _
       "ist dem Autor vorbehalten." & vbCrLf & vbCrLf & _
       "              Vorgang abgebrochen.               ", vbExclamation + vbOKOnly, _
       " *** Hinweis des Autors *** " 
End If 
End Sub 
Sub MRTCode(control As IRibbonControl) 
Application.EnableCancelKey = xlDisabled 
Dim Excelversion As Byte 
If (Environ("COMPUTERNAME") = ComPuterName1 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Or _
(Environ("COMPUTERNAME") = ComPuterName2 And GetSetting("xxxxxx", "xxxxxx", "xxxxxx") _
= GetSetting("xxxxxx", "xxxxxx", "xxxxxx")) Then GoTo Fehler 
MsgBox "Sie haben nicht die notwendige Berechtigung      " & vbCrLf & _
     "zum Ausführen des Vorgangs. Dieses Makro ist     " & vbCrLf & _
       "ist dem Autor vorbehalten." & vbCrLf & vbCrLf & _
      "              Vorgang abgebrochen.               ", vbExclamation + vbOKOnly, _
      " *** Hinweis des Autors *** " 
Exit Sub 
Fehler: 
If Excelversion >= 10 Then 
On Error GoTo xpfehler 
End If 
SendKeys ("%{F11}"), True 
If Application.VBE.ActiveVBProject.Protection Then 
Select Case Excelversion 
Case "8" 
SendKeys ("%xs" & GetSetting("xxxxxx", "xxxxxx", "xxxxxx") & "{ENTER}{ENTER}"), True 
Case Else 
SendKeys ("%xi" & GetSetting("xxxxxx", "xxxxxx", "xxxxxx") & "{ENTER}{ENTER}"), True 
End Select 
End If 
Exit Sub 
xpfehler: 
MsgBox "Dieses Makro benötigt den direkten Zugriff auf VBA." & vbCrLf & vbCrLf & _
"Bitte aktivieren Sie im Menü ""Extras - Makro - Sicherheit..." & _
" - Vertrauenswürdige Quellen"" die Option ""Zugriff auf Visual Basic-Projekt vertrauen""" & _
vbCrLf & vbCrLf & "Bitte lesen Sie auch die Microsoft Sicherheitshinweise " & _
"zu dieser Einstellung! (Hilfe)" 
Exit Sub 
End Sub 

Option Explicit 
Option Private Module 
Sub HilfeAufrufen(control As IRibbonControl) 
userform1.Show 
End Sub 
Sub PlanEin(control As IRibbonControl) 
On Error Resume Next 
userform2.Show 
End Sub 
Sub ZeitManuell(control As IRibbonControl) 
UserForm3.Show 
End Sub 
Sub groupTelefonieren(control As IRibbonControl) 
On Error Resume Next 
UserForm4.Show 
End Sub