Die Makros (Ferienmodul)
Diese Makros werden in ein Standardmodul kopiert. Über sie werden die Ferienzeiträume markiert.
Option Explicit
' Dieses Makro kommt in ein Standardmodul
Sub ferien_markieren()
' Variablen deklarieren
Dim spalte As Integer
Dim vZeiArr As Variant ' Zielzeilen
Dim vFeriArr As Variant ' Ferientermine
Dim iZiel As Integer ' letzte Zeile Ferienliste
Dim zeile As Integer ' Zeile Ferienzeiträume
Dim iDiff As Integer ' Dauer der Ferien
Dim iAktTg As Long ' aktueller Tag
Dim iTgAnz As Integer ' Ferientage
Dim c As Range ' Zielbereich
Dim iZeiDi As Integer ' Zeilenkorrektur 2. Halbjahr
With Sheets("Schulferien").Range("A1:AF1") ' Suchbereich festlegen
Set c = .Find(Sheets("Kalender").Cells(2, 12), LookIn:=xlValues) ' Ausgewähltes Bundesland suchen
If Not c Is Nothing Then spalte = c.Column ' Spalte mit Daten definieren
End With ' Ende Definition
iZiel = Sheets("Schulferien").Range("A:IV").Find("*", _
searchorder:=xlByRows, searchdirection:=xlPrevious).Row ' Listenlänge ermitteln
vZeiArr = Array(2, 5, 8, 11, 14, 17, 2, 5, 8, 11, 14, 17) ' Spalten für Einträge
vFeriArr = Sheets("Schulferien").Range(Sheets("Schulferien").Cells _
(2, spalte), Sheets("Schulferien").Cells(iZiel, spalte + 1)).Value2 ' Ferientermine in Array übertragen
With Range("B6:B71,E6:E71,H6:H71,K6:K71,N6:N71,Q6:Q71").Borders(xlEdgeRight) ' Bereiche für Markierungen
.LineStyle = xlNone ' keine Linie
.ColorIndex = xlNone ' keine Farbe
End With ' Ende löschen
For zeile = 1 To iZiel - 1 ' laufe vom ersten zum letzten Termin
iZeiDi = 0
If Year(vFeriArr(zeile, 1)) = Sheets("Kalender").Cells(2, 4) Then ' wenn Kalenderjahr des Termins gleich akt. Jahr im Kalender, dann ...
iDiff = DateDiff("d", vFeriArr(zeile, 1), vFeriArr(zeile, 2)) + 1 ' ... berechne Ferienlänge
For iTgAnz = 0 To iDiff - 1 ' ... laufe durch Array
iAktTg = vFeriArr(zeile, 1) + iTgAnz ' ... Tagesdatum in Variable
If Month(CDate(iAktTg)) > 6 Then iZeiDi = 35
With Sheets("Kalender").Cells(Day(CDate(iAktTg)) + 5 + iZeiDi _
, vZeiArr(Month(CDate(iAktTg)) - 1)).Borders(xlEdgeRight) ' ... Zelle (Rahmen) markieren
.LineStyle = xlContinuous ' ... durchgehende Linie
.Weight = xlThick ' Linienstärke dick
.ColorIndex = 4 ' ... Farbe grün
End With
Next iTgAnz ' Ende markieren
End If
Next zeile
End Sub
Diese Zeile wird in das Makro kalender im Modul1 eingefügt.
ferien_markieren ' Start der Ferienmarkierung
End Sub
Dieses Makro kommt in das Modul des UserForms Schichtkalender.
' Dieses Makro kommt in das Modul des UserForm (Schichtkalender)
Private Sub ComboBox3_Change()
Sheets("Kalender").Cells(2, 12) = ComboBox3.Text ' Name des gewählten Bundeslandes in den Kalender schreiben
ferien_markieren ' Modul zum Markieren aufrufen
End Sub
Quelltexte eingefügt mit: Excel Code Jeanie
Ferienmodul für Monatsseiten
Dieses Makro eignet sich für Kalender, bei denen für jeden Monat eine eigene Seite verwendet wird.
Option Explicit
Sub ferien_markieren()
' Variablen deklarieren
Dim spalte As Integer
Dim vZeiArr As Variant ' Zielzeilen
Dim vFeriArr As Variant ' Ferientermine
Dim iZiel As Integer ' letzte Zeile Ferienliste
Dim zeile As Integer ' Zeile Ferienzeiträume
Dim iDiff As Integer ' Dauer der Ferien
Dim iAktTg As Long ' aktueller Tag
Dim iTgAnz As Integer ' Ferientage
Dim c As Range ' Zielbereich
Dim iZeiDi As Integer ' Zeilenkorrektur 2. Halbjahr
Dim varMonArr As Variant ' Monate (Namen der Tabellenblätter)
Dim intMona As Integer ' aktueller Monat
Dim intAnz As Integer ' Datenzähler für Array
Dim Blatt As Object ' Tabellenblatt
' Namen der Tabellenblätter auslesen
varMonArr = Array("Jan", "Feb", "März", "Apr", "Mai", "Jun", _
"Jul", "Aug", "Sep", "Okt", "Nov", "Dez") ' Namen der Tabellenblätter (bei Bedarf anpassen)
With Sheets("Schulferien").Range("A1:AF1") ' Suchbereich festlegen
Set c = .Find(Sheets("Schichtfolge").Cells(1, 10), LookIn:=xlValues) ' Ausgewähltes Bundesland suchen
If Not c Is Nothing Then spalte = c.Column ' Spalte mit Daten definieren
End With ' Ende Definition
' Ferienzeiträume auslesen
iZiel = Sheets("Schulferien").Range("A:IV").Find("*", _
searchorder:=xlByRows, searchdirection:=xlPrevious).Row ' Listenlänge ermitteln
vZeiArr = Array(2, 5, 8, 11, 14, 17, 2, 5, 8, 11, 14, 17) ' Spalten für Einträge
vFeriArr = Sheets("Schulferien").Range(Sheets("Schulferien").Cells _
(2, spalte), Sheets("Schulferien").Cells(iZiel, spalte + 1)).Value2 ' Ferientermine in Array übertragen
' Markierungen zurück setzen
For intMona = 0 To 11 ' Monate auffrufen
With Sheets(varMonArr(intMona, 0)).Range("B3:B" & Sheets(varMonArr _
(intMona, 0)).Range("A3").End(xlDown).Row).Borders(xlEdgeRight) ' Bereich für Markierungen
.LineStyle = xlContinuous ' Linie durchgehend
.Weight = xlMedium ' Linie mittelstark
.ColorIndex = 1 ' schwarze Farbe
End With ' Ende löschen
Next intMona ' nächster Monat
' Neue Markierung
For zeile = 1 To iZiel - 1 ' laufe vom ersten zum letzten Termin
iZeiDi = 0
If Year(vFeriArr(zeile, 1)) = Sheets("Hilfen").Cells(1, 1) Then ' wenn Kalenderjahr des Termins gleich akt. Jahr im Kalender, dann ...
iDiff = DateDiff("d", vFeriArr(zeile, 1), vFeriArr(zeile, 2)) + 1 ' ... berechne Ferienlänge
For iTgAnz = 0 To iDiff - 1 ' ... laufe durch Array
iAktTg = vFeriArr(zeile, 1) + iTgAnz ' ... Tagesdatum in Variable
With Sheets(varMonArr(Month(CDate(iAktTg)) - 1, 0)).Cells _
(Day(CDate(iAktTg)) + 2 + iZeiDi, 2).Borders(xlEdgeRight) ' ... Zelle (Rahmen) markieren
.LineStyle = xlContinuous ' ... durchgehende Linie
.Weight = xlThick ' Linienstärke dick
.ColorIndex = 4 ' ... Farbe grün
End With ' Ende markieren
Next iTgAnz ' nächster Tag
End If ' Ende markieren
Next zeile ' nächste zeile
End Sub
Code eingefügt mit: Excel Code Jeanie