Probleme mit Urlaubsplan
12.11.2003 17:12:47
Andreas
ich habe von Hans seiner CD unten stehender Code übernommen.Blatt eins nennt sich datenbank und in Spalte A stehen die Namen der Mitarbeiter.Dann kommen 12 Monatsblätter mit jeweils dem Kalender von Jan bis Dez.Auf diese Blätter wird per ist gleich-Formel die Namen der Datenbank ebenfalls in Spalte A der jeweiligen Monate übernommen.In Blatt Datenbank wird in Spalte B und C jeweils das Urlaubsstart und Enddatum eingetragen.Über eine Schaltfläsche wird das Makro ausgelöst und trägt den Urlaub auch richtig ein.Nur der 30.Dezember wird bei allen Mitarbeitern markiert obwohl für diese Zeit kein Urlaub eingetragen wurde.Wo liegt der Fehler.Und ohne das ich jetzt unverschämt wirken möchte.
Wie ereiche ich das in Spalte A der Vorname und in B der Nachname übernommen wird.Und ist es möglich die Eingaben über eine Maske vorzunehmen ?
Langer Text und viele Wünsche, tut mir leid. :-((
Gruss Andreas
Sub UrlaubsEintrag()
Dim rngFind As Range
Dim intRow As Integer, intMonth As Integer, intCounter As Integer
intRow = 3
Do Until IsEmpty(Cells(intRow, 1))
For intMonth = Month(Cells(intRow, 2)) To Month(Cells(intRow, 3))
Set rngFind = Worksheets(Format(DateSerial(1, intMonth, 1), "mmmm")). _
Columns(1).Find _
(Cells(intRow, 1), LookIn:=xlValues, lookat:=xlWhole)
If intMonth = Month(Cells(intRow, 2)) And intMonth = _
Month(Cells(intRow, 3)) Then
For intCounter = Day(Cells(intRow, 2)) To Day(Cells(intRow, 3))
rngFind.Offset(0, intCounter).Interior.ColorIndex = 3
Next intCounter
ElseIf intMonth = Month(Cells(intRow, 2)) Then
For intCounter = Day(Cells(intRow, 2)) To Day(DateSerial _
(1, Month(Cells(intRow, 2)) + 1, 0))
rngFind.Offset(0, intCounter).Interior.ColorIndex = 3
Next intCounter
Else
For intCounter = 1 To Day(Cells(intRow, 3))
rngFind.Offset(0, intCounter).Interior.ColorIndex = 3
Next intCounter
End If
Next intMonth
intRow = intRow + 1
Loop