VBA Felder in verschiedenen Tabellenblättern färbe

Hi, ich habe folgendens Problem, ich habe einen Urlaubsplaner erstellt, dabei hat jeder Monat ein eigenes Tabellenblatt und es gibt eine erste Seite, auf der man per Button zu bestimmten Tabellenblättern springen kann.
Für die Planung soll jeder Mitarbeiter die entsprechenden Felder in der Tabelle für den jeweiligen Monat farbig markieren.
Ich habe soweit alles fertig und bin jetzt dabei ein UserForm zu erstellen, in welchem man auswählen kann, wann man abwesend ist, wer abwesend ist und welchen Grund dies hat.
Der Grund gibt die Farbe an, mit welcher markiert wird.
Das UserForm funktioniert auch, bis auf das färben der Felder.
Ich bräuchte also einen Code, der die DTPicker für das Datum auswertet, dann in das passende Tabellenblatt springt und dort nach dem jeweiligen Mitarbeiter sucht um dann die Felder (Tage z.B. 1-15) farbig markiert.
So sieht mein Code bis jetzt aus:

Private Sub UserForm_Initialize()
ComboBox2.AddItem "Urlaub"
ComboBox2.AddItem "GLZ"
ComboBox2.AddItem "Abwesenheit"
ComboBox1.RowSource = "Tabelle1!A1:A5"
End Sub

Private Sub CommandButton1_Click()
Application.EnableEvents = False
If DTPicker1 > DTPicker2 Then
MsgBox "Das Endedatum muss größer sein als das Startdatum"
Exit Sub
End If
If UserForm1.ComboBox1.Value = "" Then
MsgBox "Bitte einen Mitarbeiter auswählen"
Exit Sub
End If
If UserForm1.ComboBox2.Value = "" Then
MsgBox "Bitte einen Abwesenheitsgrund auswählen"
Exit Sub
End If
If UserForm1.ComboBox2.Value = "Abwesenheit" Then farbe = vbGreen
If UserForm1.ComboBox2.Value = "Urlaub" Then farbe = vbBlue
If UserForm1.ComboBox2.Value = "GLZ" Then farbe = vbYellow
Ich habe auch mal die komplette Datei hochgeladen: https://www.herber.de/bbs/user/101213.xlsm
Vielen Dank im Voraus.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

…Ole,
denn sie ist beim 1.Mal anscheinend verloren gegangen. Das passiert leider mitunter.
Ansonsten kannst du die 3 letzten CodeZeilen auch so schreiben …

With UserForm1.ComboBox2
farbe = Switch(.Value = "Abwesenheit", vbGreen, .Value = "Urlaub", vbBlue, _
.Value = "GLZ", vbYellow)
End With

…oder so …

Select Case UserForm1.ComboBox2.Value
Case "Abwesenheit": farbe = vbGreen
Case "Urlaub": farbe = vbBlue
Case "GLZ": farbe = vbYellow
End Select

Kleiner Tipp: Wenn du die HTML-Pre-Tags nicht benutzt, solltest du eine gepostete Prozedur immer mit End … abschließen, sonst stellt die ForumsSoftware alles, was an Text nach der letzten CodeZeile kommt, als dem PgmCode zugehörig dar. Das könnte ggf auch Probleme beim AWen verursachen.
Gruß, Luc :-?
Besser informiert mit …

Private Sub CommandButton1_Click() Application.EnableEvents = False If DTPicker1 > DTPicker2 Then MsgBox "Das Endedatum muss größer sein als das Startdatum" Exit Sub End If If UserForm1.ComboBox1.Value = "" Then MsgBox "Bitte einen Mitarbeiter auswählen" Exit Sub End If If UserForm1.ComboBox2.Value = "" Then MsgBox "Bitte einen Abwesenheitsgrund auswählen" Exit Sub End If With UserForm1.ComboBox2 farbe = Switch(.Value = "Abwesenheit", vbGreen, .Value = "Urlaub", vbBlue, _ .Value = "GLZ", vbYellow) End With End Sub

Private Sub CommandButton1_Click() Const adMABer$ = "A3:A7" Dim farbe As Long, Datum(1) As Date, Marb As String, _ relMABer As Range, aWs As Worksheet On Error GoTo ex Application.EnableEvents = False Set aWs = ActiveSheet If DTPicker1 > DTPicker2 Then MsgBox "Das Endedatum muss größer sein als das Startdatum!", _ vbExclamation: GoTo ex Else: Datum(0) = CDate(DTPicker1): Datum(1) = CDate(DTPicker2) If Month(Datum(0)) Month(Datum(1)) Then _ MsgBox "Das Endedatum muss im gleichen Monat liegen!", _ vbExclamation: GoTo ex End If If UserForm1.ComboBox1.Value = "" Then MsgBox "Bitte einen Mitarbeiter auswählen": Exit Sub Else: Marb = UserForm1.ComboBox1.Value End If Select Case UserForm1.ComboBox2.Value Case "": MsgBox "Bitte einen Abwesenheitsgrund auswählen!", _ vbExclamation: GoTo ex Case "Abwesenheit": farbe = vbGreen Case "Urlaub": farbe = vbBlue Case "GLZ": farbe = vbYellow End Select Set relMABer = aWs.Range(adMABer) Set relMABer = relMABer.Cells(WorksheetFunction.Match(Marb, _ relMABer, 0)).EntireRow Set relMABer = aWs.Range(relMABer.Cells(1, Day(Datum(0)) + 1), _ relMABer.Cells(1, Day(Datum(1)) + 1)) relMABer.Interior.Color = farbe ex: Application.EnableEvents = True UserForm1.Hide: Set aWs = Nothing: Set relMABer = Nothing If CBool(Err.Number) Then _ MsgBox Err.Description, vbCritical, "Fehler: " & Err.Number End Sub

Beliebteste Forumthreads (12 Monate)

VBA Felder in verschiedenen Tabellenblättern färbe

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Felder in verschiedenen Tabellenblättern färbe

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread