Geht's einfacher?
11.03.2024 07:38:11
Nordic
ich habe in den letzten Tag so gut es mir möglich war etwas zusammengebastelt.
Irgendwie beschleicht mich jedoch das Gefühl, dass ich mehr Aufwand betrieben habe als nötig.
Was soll passieren? Im Grunde ist es eine Art ToDo-Liste, die Mo - Do bestimmte Gegebenheiten überprüft und in einem Textfeld ausgibt.
Private Sub UserForm_Activate()
Dim ws As Worksheet
Dim executionDay As Integer
Dim toDay As String
Dim currentDay As String
Dim currentDate As Date
Dim foundDate As Date
Dim actorNew As String
Dim allActorsNew As String
Dim actorEnd As String
Dim allActorsEnd As String
Dim actorRep As String
Dim allActorsRep As String
Dim actorSoon As String
Dim allActorsSoon As String
Dim infoToDay1 As String
Dim infoToDay2 As String
Dim infoToDay3 As String
Dim i As Long
Set ws = ThisWorkbook.Sheets("Projektplan")
UserForm2.TextBox1.Value = ""
executionDay = Weekday(Date, vbMonday)
currentDate = Date
If executionDay = 1 Then
toDay = gWeekday(executionDay)
UserForm2.TextBox1.Value = "Tagesinfo für " & toDay & ", den " & currentDate
currentDay = TextBox1.Text & vbCrLf
For i = 7 To gLR
If IsDate(ws.Cells(i, "R").Value) Then
foundDate = ws.Cells(i, "R").Value
If currentDate + 7 = foundDate Then
actor = ws.Cells(i, "B").Value
allActors = allActors & vbCrLf & actor & " am " & foundDate
End If
End If
Next i
If allActors > "" Then
UserForm2.TextBox1.Value = currentDay & vbCrLf & _
"Für folgende TN endet die Maßnahme in 7 Tagen." & vbCrLf & _
"Ggf. Verlängerungen prüfen!" & vbCrLf & allActors
Else
UserForm2.TextBox1.Value = currentDay & vbCrLf & _
"Kein TN endet in 7 Tagen." & vbCrLf & _
"Prüfen auf Verlängerungen optional."
End If
End If
If executionDay = 2 Then
toDay = gWeekday(executionDay)
UserForm2.TextBox1.Value = "Tagesinfo für " & toDay & ", den " & currentDate
currentDay = TextBox1.Text & vbCrLf
For i = 7 To gLR
If IsDate(ws.Cells(i, "R").Value) Then
foundDate = ws.Cells(i, "R").Value
If currentDate + 7 = foundDate Then
actor = ws.Cells(i, "B").Value
allActors = allActors & vbCrLf & actor & " am " & foundDate
End If
End If
Next i
If allActors > "" Then
UserForm2.TextBox1.Value = currentDay & vbCrLf & _
"Für folgende TN endet die Maßnahme in 7 Tagen.." & vbCrLf & _
"Ggf. Verlängerungen prüfen!" & vbCrLf & allActors
Else
UserForm2.TextBox1.Value = currentDay & vbCrLf & _
"Kein TN endet in 7 Tagen." & vbCrLf & _
"Prüfen auf Verlängerungen obligatorisch!"
End If
End If
If executionDay = 3 Then
toDay = gWeekday(executionDay)
UserForm2.TextBox1.Value = "Tagesinfo für " & toDay & ", den " & currentDate
currentDay = TextBox1.Text & vbCrLf
For i = 7 To gLR
If IsDate(ws.Cells(i, "D").Value) Then
foundDate = ws.Cells(i, "D").Value
If currentDate = foundDate Then
actorNew = ws.Cells(i, "B").Value
allActorsNew = allActorsNew & vbCrLf & actorNew
End If
End If
If IsDate(ws.Cells(i, "R").Value) Then
foundDate = ws.Cells(i, "R").Value
If currentDate + 1 = foundDate Then
actorEnd = ws.Cells(i, "B").Value
allActorsEnd = allActorsEnd & vbCrLf & actorEnd
End If
End If
If IsDate(ws.Cells(i, "U").Value) Then
foundDate = ws.Cells(i, "U").Value
If currentDate + 1 = foundDate Then
actorRep = ws.Cells(i, "B").Value
allActorsRep = allActorsRep & vbCrLf & actorRep
End If
End If
Next i
If allActorsNew > "" Then
UserForm2.TextBox1.Value = currentDay & vbCrLf & _
"Für folgende TN ist heute der Maßnamestart geplant:" & vbCrLf & allActorsNew
infoToDay1 = TextBox1.Text & vbCrLf
Else
UserForm2.TextBox1.Value = currentDay & vbCrLf & _
"Es sind für heute keine Zugänge geplant."
infoToDay1 = TextBox1.Text & vbCrLf
End If
If allActorsEnd > "" Then
UserForm2.TextBox1.Value = "Maßnameende morgen:" & vbCrLf & allActorsEnd
infoToDay2 = TextBox1.Text & vbCrLf
Else
UserForm2.TextBox1.Value = "Kein Maßnameende morgen."
infoToDay2 = TextBox1.Text & vbCrLf
End If
If allActorsRep > "" Then
UserForm2.TextBox1.Value = "Berichte morgen fällig:" & vbCrLf & allActorsRep
infoToDay3 = TextBox1.Text & vbCrLf
Else
UserForm2.TextBox1.Value = "Keine Berichtsabgaben morgen"
infoToDay3 = TextBox1.Text & vbCrLf
End If
UserForm2.TextBox1.Value = infoToDay1 & vbCrLf & infoToDay2 & vbCrLf & infoToDay3
End If
If executionDay = 4 Then
toDay = gWeekday(executionDay)
UserForm2.TextBox1.Value = "Tagesinfo für " & toDay & ", den " & currentDate
currentDay = TextBox1.Text & vbCrLf
For i = 7 To gLR
If IsDate(ws.Cells(i, "D").Value) Then
foundDate = ws.Cells(i, "D").Value
If currentDate + 6 = foundDate Then
actorSoon = ws.Cells(i, "B").Value
allActorsSoon = allActorsSoon & vbCrLf & "> " & actorSoon & " am " & foundDate
End If
End If
If IsDate(ws.Cells(i, "R").Value) Then
foundDate = ws.Cells(i, "R").Value
If currentDate + 4 = foundDate Then
actorEnd = ws.Cells(i, "B").Value
allActorsEnd = allActorsEnd & vbCrLf & "> " & actorEnd & " am " & foundDate
End If
End If
If IsDate(ws.Cells(i, "U").Value) Then
foundDate = ws.Cells(i, "U").Value
If currentDate + 4 = foundDate Then
actorRep = ws.Cells(i, "B").Value
allActorsRep = allActorsRep & vbCrLf & "> " & actorRep & " am " & foundDate
End If
End If
Next i
If allActorsSoon > "" Then
UserForm2.TextBox1.Value = currentDay & vbCrLf & _
"Einladungen zum Maßnamestart versenden an:" & vbCrLf & allActorsSoon
infoToDay1 = TextBox1.Text & vbCrLf
Else
UserForm2.TextBox1.Value = currentDay & vbCrLf & _
"Für nächsten Mittwoch sind keine Zugänge vorgesehen."
infoToDay1 = TextBox1.Text & vbCrLf
End If
If allActorsEnd > "" Then
UserForm2.TextBox1.Value = "Folgende TN enden am Montag:" & vbCrLf & _
"Dokumentation und TN Ordner prüfen!" & vbCrLf & allActorsEnd
infoToDay2 = TextBox1.Text & vbCrLf
Else
UserForm2.TextBox1.Value = "Für Montag sind keine Austritte vorgesehen"
infoToDay2 = TextBox1.Text & vbCrLf
End If
If allActorsRep > "" Then
UserForm2.TextBox1.Value = "Für folgende TN ist am Montag ein Bericht abzugeben:" & vbCrLf & allActorsRep
infoToDay3 = TextBox1.Text & vbCrLf
Else
UserForm2.TextBox1.Value = "Für Montag sind keine Berichtsabgaben vorgesehen"
infoToDay3 = TextBox1.Text & vbCrLf
End If
UserForm2.TextBox1.Value = infoToDay1 & vbCrLf & infoToDay2 & vbCrLf & infoToDay3
End If
End Sub
https://www.herber.de/bbs/user/167923.xlsm
Vielleicht hat jemand eine Idee wie der Code schlanker wird, ohne dabei die "Übersichtlichkeit" einzubüßen.
Grüße zum Wochenstart, Nordic (Uwe)