MsgBox ausdrucken

Sub alleUrlaube()
Set WshShell = CreateObject("WScript.Shell")
alleUrl = ""
clStart = Range("MonJanuar").Column
clJan = Range("MonJanuar").Columns.Count
clTotal = clJan * 12
Application.ScreenUpdating = False
Worksheets("Kalender").Activate
Worksheets("Kalender").Unprotect
For m = clStart To clTotal Step clJan                       ' Schleife für Monate
For t = 3 To 33                                         ' Schleife für Tage
If Cells(t, m + 10) <> "" _
And Cells(t - 1, m + 10) <> Cells(t, m + 10) Or IsNumeric(Cells(t - 1, m + 10)) _
And (Cells(t, m + 10) = "U" Or Cells(t, m + 10) = "UKi" Or Cells(t, m + 10) = "?") _
And Cells(t + 28, m - 1) <> "U" And Cells(t + 28, m - 1) <> "UKi" And Cells(t + 28, m - 1) <> "?" _
And Cells(t + 29, m - 1) <> "U" And Cells(t + 29, m - 1) <> "UKi" And Cells(t + 29, m - 1) <> "?" _
And Cells(t + 30, m - 1) <> "U" And Cells(t + 30, m - 1) <> "UKi" And Cells(t + 30, m - 1) <> "?" _
Then
If Cells(t, m + 10) <> Cells(t + 28, m - 1) _
And Cells(t, m + 10) <> Cells(t + 29, m - 1) _
And Cells(t, m + 10) <> Cells(t + 30, m - 1) _
Then
'## evtuelle Ferien einlesen:
If Cells(t, m + 4) <> "" Then
strFerien = "( " & Cells(t, m + 4) & " )    "
Else
strFerien = ""
End If
'## Aktivität des Urlaubes einlesen mit der Funktion "GetZeile1" von FP/herber.de:
UrlGrund = GetZeile1(Cells(t, m + 2))   '... dann nur die erste Zeile verwenden;
'## ersten Tag eines Urlaubes einlesen:
UrlAnfDat = Cells(t, m)
'## Ermittlung des letzten Tages des Urlaubes:
ssss = Cells(t, m).Address
clAnfDat = Range(ssss).Column
For mm = clAnfDat To clTotal Step clJan   ' Schleife für Monate, beginnend ab dem Monat, in dem der erste Tag liegt: "clAnfDat"
For tt = 3 To 33                      ' Schleife für Tage
If Cells(tt, mm) > UrlAnfDat Then
If Cells(tt, mm + 10) = "" Or Cells(tt, mm + 10) <> Cells(tt - 1, mm + 10) _
And Cells(tt, mm + 10) <> Cells(tt + 28, mm - 1) _
And Cells(tt, mm + 10) <> Cells(tt + 29, mm - 1) _
And Cells(tt, mm + 10) <> Cells(tt + 30, mm - 1) _
And Cells(tt - 1, mm + 10) <> "" Then
UrlEndDat = Cells(tt, mm) - 1
UrlEndDatFoundCheck = True
Exit For
End If
End If
Next
If UrlEndDatFoundCheck = True Then
UrlEndDatFoundCheck = False
Exit For
End If
Next
'## Anzahl der benötigten Urlaubstage:
UrlTage = ATC(UrlAnfDat, UrlEndDat, Range("Feiertage"))
'## Anzahl der Tage/Arbeitstage bis zum Urlaub:
If Not UrlAnfDat < Date Then    'ohne Abfrage Fehlermeldung bei vergangenen Urlauben
nochTage = UrlAnfDat - Date
Else
nochTage = 0
End If
nochArbTage = ATC(Date, UrlAnfDat, Range("Feiertage"))
'## zusammensetzen der Einzelteile eines Urlaubes:
If strFerien <> "" Then
If nochTage > 0 Then    'Wenn der Urlaub in der Zukunft, die Tage bis zum UrlBeginn schreiben
UrlTxt = Chr(13) & Cells(t, m + 10) & " (" & UrlTage & ")" & _
Chr(9) & UrlAnfDat & "  -  " & UrlEndDat & _
Chr(9) & strFerien & Chr(9) & UrlGrund & Chr(13) & _
Chr(9) & "in   " & nochTage & "  Tagen  " & "( Arbt.: " & nochArbTage & " )" & Chr(13)
Else
UrlTxt = Chr(13) & Cells(t, m + 10) & " (" & UrlTage & ")" & _
Chr(9) & UrlAnfDat & "  -  " & UrlEndDat & _
Chr(9) & strFerien & Chr(9) & UrlGrund & Chr(13)
End If
Else
If nochTage > 0 Then    'Wenn der Urlaub in der Zukunft, die Tage bis zum UrlBeginn schreiben
UrlTxt = Chr(13) & Cells(t, m + 10) & " (" & UrlTage & ")" & _
Chr(9) & UrlAnfDat & "  -  " & UrlEndDat & _
Chr(9) & Chr(9) & Chr(9) & UrlGrund & Chr(13) & _
Chr(9) & "in   " & nochTage & "  Tagen  " & "( Arbt.: " & nochArbTage & " )" & Chr(13)
Else
UrlTxt = Chr(13) & Cells(t, m + 10) & " (" & UrlTage & ")" & _
Chr(9) & UrlAnfDat & "  -  " & UrlEndDat & _
Chr(9) & Chr(9) & Chr(9) & UrlGrund & Chr(13)
End If
End If
'## einzelne Urlaube zeilenweise aneinander fügen:
alleUrl = alleUrl + UrlTxt
End If
End If
Next t
Next m
'## Sucht für Zelle "C12" das Datum des nächsten Urlaubs:
For m = clStart To clTotal Step clJan                       ' Schleife für Monate
For t = 3 To 33                                         ' Schleife für Tage
If Cells(t, m + 10) <> "" And Cells(t, m) > Date _
And Cells(t - 1, m + 10) = "" Or IsNumeric(Cells(t - 1, m + 10)) _
And (Cells(t, m + 10) = "U" Or Cells(t, m + 10) = "UKi" Or Cells(t, m + 10) = "?") _
And Cells(t + 28, m - 1) <> "U" And Cells(t + 28, m - 1) <> "UKi" And Cells(t + 28, m - 1) <> "?" _
And Cells(t + 29, m - 1) <> "U" And Cells(t + 29, m - 1) <> "UKi" And Cells(t + 29, m - 1) <> "?" _
And Cells(t + 30, m - 1) <> "U" And Cells(t + 30, m - 1) <> "UKi" And Cells(t + 30, m - 1) <> "?" _
Then
UrlAnfDat = Cells(t, m)
Range("UrlaubsDatum") = UrlAnfDat
UrlEndDatFoundCheck = True
Exit For
End If
Next
If UrlEndDatFoundCheck = True Then
UrlEndDatFoundCheck = False
Exit For
End If
Next
Application.ScreenUpdating = True
Worksheets("Kalender").Protect
'## Erstellen der Anfangszeilen der MsgBox:
GesUrl = Chr(13) & _
"Urlaubsplanung:" & Chr(9) & "Urlaubstage " & Chr(9) & [c10] & Chr(9) & "( ""U"", ""UKi"" )" & _
Chr(9) & Chr(9) & Format(Date, "dddd, dd. mmmm yyyy") & Chr(13) & _
Chr(9) & Chr(9) & "vielleicht noch " & Chr(9) & [c11] & Chr(9) & "( ""?"" )" & Chr(13) & _
Chr(9) & Chr(9) & Chr(9) & Chr(9) & "---" & Chr(13) & _
"benötigte Urlaubstage gesamt:" & Chr(9) & [c10] + [c11] & _
Chr(9) & "( maximaler Urlaub:  " & [c9] & " )" & Chr(13) & _
"----------------------------------------------------------------------------------------------------------------------------------                " & Chr(13)
'## Gesamttext für MsgBox zusammenstellen:
If alleUrl <> "" Then   ' wenn Urlaube im ausgewählten Jahr eingetragen:
intText = WshShell.Popup(GesUrl & alleUrl & Chr(13) & Chr(13) & _
"( In Klammern die Anzahl der jeweils benötigten Urlaubstage )" & Chr(13) & _
Chr(13), 50, "fwGesamturlaub", 4160)
Else                    ' wenn keine Urlaube im ausgewählten Jahr eingetragen:
intText = WshShell.Popup(GesUrl & _
"Für das Jahr   [ " & [a1] & " ]   ist kein Urlaub eingetragen." & Chr(13) & Chr(13), 50, "fwGesamturlaub", 4160)
End If
End Sub