UF füllen mit vorhandenen Daten
16.06.2022 10:54:52
Ulf
ich könnte wieder einmal Eure geschätzte Hilfe gebrauchen. Mit dem folgenden Code fülle ich bisher meine Userform und bin damit auch soweit zufrieden. Es soll jedoch eine zusätzliche Funktion mit eingebunden werden, die bereits ausgefüllte Zellen in der UF mit anzeigen soll.
Private Sub UserForm_Initialize()
With ListBox_WT
.AddItem "Montag"
.AddItem "Dienstag"
.AddItem "Mittwoch"
.AddItem "Donnerstag"
.AddItem "Freitag"
.AddItem "Samstag"
.AddItem "Sonntag"
.Text = "Montag"
End With
With ListBox_KW
.AddItem DINKw(Date) - 1
.AddItem DINKw(Date)
.AddItem DINKw(Date) + 1
.AddItem DINKw(Date) + 2
.AddItem DINKw(Date) + 3
.Text = DINKw(Date) + 1
End With
With Schicht
.AddItem "Früh"
.AddItem "Spät"
.AddItem "Nacht"
.AddItem "Normal"
.Text = "Früh"
End With
Dim i As Integer
For i = 1 To 32
Controls("LAN_Pos" & CStr(i)).RowSource = "Hilfe!A1:A10"
Controls("MA_Pos" & CStr(i)).RowSource = "Hilfe!A1:A10"
Controls("MA_Name" & CStr(i)).RowSource = "PersonalMA!B2:B500"
Controls("LAN_Name" & CStr(i)).RowSource = "PersonalLAN!B2:B300"
Next i
Combo_Zu.RowSource = "Hilfe!B1:B5"
Text_Datum.Value = DatInWoche(Year(Date), ListBox_KW.Value, 1)
Text_JahrKW.Value = Year(Date) & "-" & DINKw(Date) + 1
Combo_FB.RowSource = "Hilfe!D1:D13"
Combo_FB.Value = ActiveSheet.Name
If ActiveSheet.Name = "M0" Or ActiveSheet.Name = "M1" Or ActiveSheet.Name = "M2" Or ActiveSheet.Name = "M3" Or ActiveSheet.Name = "M4" Then
Combo_Zu.Value = "Name1"
ElseIf ActiveSheet.Name = "M5" Or ActiveSheet.Name = "M6" Or ActiveSheet.Name = "M7" Then
Combo_Zu.Value = "Name2"
ElseIf ActiveSheet.Name = "M8" Or ActiveSheet.Name = "M9" Or ActiveSheet.Name = "M10" Then
Combo_Zu.Value = "Name3"
End If
Me.Height = 400
Me.Width = 735
Me.ScrollBars = fmScrollBarsVertical
Me.ScrollHeight = 1150
End Sub
Function DINKw(DAT As Date) As Integer
Dim kw As Integer
kw = Int((DAT - DateSerial(Year(DAT), 1, 1) + _
((Weekday(DateSerial(Year(DAT), 1, 1)) + 1) _
Mod 7) - 3) / 7) + 1
If kw = 0 Then
kw = DINKw(DateSerial(Year(DAT) - 1, 12, 31))
ElseIf kw = 53 And (Weekday(DateSerial(Year(DAT), 12, 31)) - 1) Mod 7 Das Datum steht dabei in Zeile 3, Spalte C, F, I, L, O, R & U
Die Angabe der jeweiligen Schicht ist in der Zeile darunter
Und die Daten dazu stehen stehen dann in den Zeilen 5 bis 36
Es sollen also immer 4 x 32 Zellen ausgelesen werden
If ActiveSheet.Range("C3") = DatInWoche(Year(Date), ListBox_KW.Value, 1) And Schicht = "Früh" And ActiveSheet.Range("B5") > "" Then
MA_Name1.Value = ActiveSheet.Range("B5")
MA_Pos1.Value = ActiveSheet.Range("A5")
End If
If ActiveSheet.Range("C3") = DatInWoche(Year(Date), ListBox_KW.Value, 1) And Schicht = "Spät" And ActiveSheet.Range("C5") > "" Then
MA_Name1.Value = ActiveSheet.Range("C5")
MA_Pos1.Value = ActiveSheet.Range("A5")
End If
If ActiveSheet.Range("C3") = DatInWoche(Year(Date), ListBox_KW.Value, 1) And Schicht = "Nacht" And ActiveSheet.Range("D5") > "" Then
MA_Name1.Value = ActiveSheet.Range("D5")
MA_Pos1.Value = ActiveSheet.Range("A5")
End If
If ActiveSheet.Range("C3") = DatInWoche(Year(Date), ListBox_KW.Value, 1) And Schicht = "Früh" And ActiveSheet.Range("B6") > "" Then
MA_Name2.Value = ActiveSheet.Range("B6")
MA_Pos2.Value = ActiveSheet.Range("A6")
End If
If ActiveSheet.Range("C3") = DatInWoche(Year(Date), ListBox_KW.Value, 1) And Schicht = "Spät" And ActiveSheet.Range("C6") > "" Then
MA_Name2.Value = ActiveSheet.Range("C6")
MA_Pos2.Value = ActiveSheet.Range("A6")
End If
If ActiveSheet.Range("C3") = DatInWoche(Year(Date), ListBox_KW.Value, 1) And Schicht = "Nacht" And ActiveSheet.Range("D6") > "" Then
MA_Name2.Value = ActiveSheet.Range("D6")
MA_Pos2.Value = ActiveSheet.Range("A6")
End If
If ActiveSheet.Range("F3") = DatInWoche(Year(Date), ListBox_KW.Value, 2) And Schicht = "Früh" And ActiveSheet.Range("B5") > "" Then
MA_Name1.Value = ActiveSheet.Range("E5")
MA_Pos1.Value = ActiveSheet.Range("A5")
End If
If ActiveSheet.Range("F3") = DatInWoche(Year(Date), ListBox_KW.Value, 2) And Schicht = "Spät" And ActiveSheet.Range("C5") > "" Then
MA_Name1.Value = ActiveSheet.Range("F5")
MA_Pos1.Value = ActiveSheet.Range("A5")
End If
If ActiveSheet.Range("F3") = DatInWoche(Year(Date), ListBox_KW.Value, 2) And Schicht = "Nacht" And ActiveSheet.Range("D5") > "" Then
MA_Name1.Value = ActiveSheet.Range("G5")
MA_Pos1.Value = ActiveSheet.Range("A5")
End If
If ActiveSheet.Range("F3") = DatInWoche(Year(Date), ListBox_KW.Value, 2) And Schicht = "Früh" And ActiveSheet.Range("B6") > "" Then
MA_Name2.Value = ActiveSheet.Range("E6")
MA_Pos2.Value = ActiveSheet.Range("A6")
End If
If ActiveSheet.Range("F3") = DatInWoche(Year(Date), ListBox_KW.Value, 2) And Schicht = "Spät" And ActiveSheet.Range("C6") > "" Then
MA_Name2.Value = ActiveSheet.Range("F6")
MA_Pos2.Value = ActiveSheet.Range("A6")
End If
If ActiveSheet.Range("F3") = DatInWoche(Year(Date), ListBox_KW.Value, 2) And Schicht = "Nacht" And ActiveSheet.Range("D6") > "" Then
MA_Name2.Value = ActiveSheet.Range("G6")
MA_Pos2.Value = ActiveSheet.Range("A6")
End If
Gruß Ulf