Im Kalender bestimmte Tage markieren

Dieses Thema Im Kalender bestimmte Tage markieren im Forum "Microsoft Office Suite" wurde erstellt von nok106, 22. Aug. 2006.

Thema: Im Kalender bestimmte Tage markieren Hallo zusammen ! Gibt es hierfür eine Lösung? Ich möchte in einem selbsterstellten Kalender, beginnend an einem...

  1. Hallo zusammen !

    Gibt es hierfür eine Lösung?

    Ich möchte in einem selbsterstellten Kalender, beginnend an einem xbeliebigen Tag, dann alle 20 Tage, fortlaufend weiter, das betreffende Datum farbig markieren.

    Ich habe es mal mit der bedingten Formatierung versucht, aber ohne Erfolg.

    Hat jemand eine Idee ob das geht und wenn ja- wie ???

    Einstweilen herzlichen Dank an alle, die sich für mich bemühen.

    Gruß

    Odje
     
  2. Wie ist denn dein Kalender aufgebaut - Zeilen, Spalten, Inhalt ...

    Gruß Matjes :)
     
  3. Hallo nok106,

    also wieder ein Makro  ;D  . Das Makro zum Farbe-Löschen als Zugabe.
    Als Farbe ist knallgelb (6) eingestellt. Einen Farbauswahl-Dialog hab ich mir verkniffen  ;D

    zu
    Deine Wochenenden sind mit bedingter Formatierung farblich hinterlegt. Die bedingte Formatierung gewinnt gegen den tatsächlichen Farbhintergrund. Deshalb hab ich alle 3 Zellen eine Tages farblich hinterlegt.

    Pack das ganze in ein extra Modul.

    Gruß Matjes :)
    Code:
    Option Explicit
    
    Private Const cSP_ERSTEDATUMSSPALTE = 1 ->A
    Private Const cSP_ANZAHL_PROMONAT = 3
    Private Const cZ_ERSTEZEILE = 6
    Private Const cZ_LETZTEZEILE = cZ_ERSTEZEILE + 30
    Private Const cTAGE_ALLE20 = 20
    Private Const cMONATE_ANZAHL = 12
    Private Const cFARBINDEX = 6->tiefgelb
    '**********************************************************************************
    Sub FarbeInteriorLoeschen()
      Dim ws As Worksheet
      Dim z As Long, sp As Long
      Set ws = ActiveSheet
      For sp = cSP_ERSTEDATUMSSPALTE To cSP_ERSTEDATUMSSPALTE + (cSP_ANZAHL_PROMONAT * (cMONATE_ANZAHL)) - 1
        For z = cZ_ERSTEZEILE To cZ_LETZTEZEILE
          If ws.Cells(z, sp).Interior.ColorIndex = cFARBINDEX Then
            ws.Cells(z, sp).Interior.ColorIndex = xlColorIndexNone
          End If
        Next
      Next
      Set ws = Nothing
    End Sub
    
    '**********************************************************************************
    Sub Alle20TageFarbeInteriorSetzen()
     ->*** Voraussetzung: eine Datumszelle ist markiert
     ->***
     ->*** Für diese Datumszelle und die Datumszellen im Abstand 19 Tage
     ->*** (also alle 20 Tage) wird her Zellehintergrung auf die ausgesuchte Farbe gesetzt
     ->***
      
      Dim ws As Worksheet
      Dim lZStart As Long, lSPStart As Long, lSPmax As Long
      Dim bIstDatumSP As Boolean, sp As Long, z As Long
      Dim sTxt As String, lCIndex As Long, lTZ As Long
      
      Set ws = ActiveSheet
      
     ->Eine Zelle markiert ?
      If Selection.Count <> 1 Then MsgBox Bitte nur eine Zelle markieren.: GoTo AUFRAEUMEN
      
     ->Datumszelle Zeile, Spalte
      lZStart = Selection.Row: lSPStart = Selection.Column
      
     ->Zeile prüfen
      If (lZStart < cZ_ERSTEZEILE) Or (lZStart > cZ_LETZTEZEILE) Then
        MsgBox Bitte eine Datums-Zelle selektieren.: GoTo AUFRAEUMEN
      End If
      
     ->Spalte prüfen
      bIstDatumSP = False
      For sp = cSP_ERSTEDATUMSSPALTE _
               To cSP_ERSTEDATUMSSPALTE + (cSP_ANZAHL_PROMONAT * (cMONATE_ANZAHL - 1)) _
               Step cSP_ANZAHL_PROMONAT
        If sp = lSPStart Then bIstDatumSP = True: Exit For
      Next
      If Not bIstDatumSP Then MsgBox Bitte eine Datums-Zelle selektieren.: GoTo AUFRAEUMEN
    
     ->Zelle prüfen
      If Not IsDate(ws.Cells(lZStart, lSPStart).Value) Then
        MsgBox Bitte eine Datums-Zelle mit Datum selektieren.: GoTo AUFRAEUMEN
      End If
      
     ->*** ist Datumszelle, also kann es jetzt losgehen
      lCIndex = cFARBINDEX
     ->Startzelle farbig, Tagezähler auf 1
      With ws.Cells(lZStart, lSPStart)
        .Interior.ColorIndex = lCIndex
        .Offset(0, 1).Interior.ColorIndex = lCIndex
        .Offset(0, 2).Interior.ColorIndex = lCIndex
      End With
      lTZ = 0       'Zähler Tage
      z = lZStart   'Zeile
      sp = lSPStart->Spalte
      lSPmax = cSP_ERSTEDATUMSSPALTE + (cSP_ANZAHL_PROMONAT * (cMONATE_ANZAHL - 1))
      Do
        z = z + 1
        If z > cZ_LETZTEZEILE Then
          z = cZ_ERSTEZEILE
          sp = sp + cSP_ANZAHL_PROMONAT
        End If
        If sp > lSPmax Then Exit Do
        If IsDate(ws.Cells(z, sp).Value) Then
          lTZ = lTZ + 1
          If lTZ = cTAGE_ALLE20 Then
            With ws.Cells(z, sp)
              .Interior.ColorIndex = lCIndex
              .Offset(0, 1).Interior.ColorIndex = lCIndex
              .Offset(0, 2).Interior.ColorIndex = lCIndex
            End With
            lTZ = 0
          End If
        End If
      Loop
      
    AUFRAEUMEN:
      Set ws = Nothing
    End Sub
     
  4. Hallo Matjes,

    für deine Bemühungen, um mein Anliegen zu lösen, meinen besten Dank.

    Ich bewundere immer wieder dein Excelwissen und dein Können, mit dem du schon unzählige Users geholfen hast.

    Ich finde es toll  :1

    Gruß

    Odje

    Hallo Matjes,

    ich möchte keinen neuen Thread anfangen, weiß aber auch nicht ob es hiermit gelingt dich nochmal ansprechen zukönnen.

    Ich versuche es mal !

    Frage: Ist die Möglichkeit gegeben das Makro so zu ändern, dass wenn der 20. Tag auf einen Samstag oder Sonntag fällt,  dann der vorhergehende Freitag oder der kommende Montag gekennzeichnet wird ?

    Sollte es nicht möglich sein wäre es kein Beinbruch !

    Mit freunlichem Gruß

    Odje
     
  5. Hallo nok106,

    ich hab beide Optionen eingebaut.  ;D

    Steuern kann man das mit der Konstanten cVERSCHIEBEN (siehe Makro)

    Trotz der Verschiebung wird der normale Rhythmus von 20 Tagen beibehalten.
    Wenn man das nicht macht und ab dem verschobenen Tag weiterzählt, erhält man nur noch Montage bzw. Freitage.

    Gruß Matjes :)
    Code:
    Option Explicit
    
    Private Const cSP_ERSTEDATUMSSPALTE = 1 ->A
    Private Const cSP_ANZAHL_PROMONAT = 3
    Private Const cZ_ERSTEZEILE = 6
    Private Const cZ_LETZTEZEILE = cZ_ERSTEZEILE + 30
    Private Const cTAGE_ALLE20 = 20
    Private Const cMONATE_ANZAHL = 12
    Private Const cFARBINDEX = 6->tiefgelb
    
    Private Const cVERSCHIEBEN As Long = 2
    ' Trifft der Tag einen Sonnabend oder Sonntag wird der Tag verschoben,
    ' In Abhängigkeit der Kennung cVerschieben
    ' cVerschieben = 0 : keine Verschiebung
    ' cVerschieben = 1 : Verschieben auf den Montag danach
    ' cVerschieben = 2 : Verschieben auf den Freitag vorher
    
    '**********************************************************************************
    Sub FarbeInteriorLoeschen()
      Dim ws As Worksheet
      Dim z As Long, sp As Long
      Set ws = ActiveSheet
      For sp = cSP_ERSTEDATUMSSPALTE To cSP_ERSTEDATUMSSPALTE + (cSP_ANZAHL_PROMONAT * (cMONATE_ANZAHL)) - 1
        For z = cZ_ERSTEZEILE To cZ_LETZTEZEILE
          If ws.Cells(z, sp).Interior.ColorIndex = cFARBINDEX Then
            ws.Cells(z, sp).Interior.ColorIndex = xlColorIndexNone
          End If
        Next
      Next
      Set ws = Nothing
    End Sub
    
    '**********************************************************************************
    Sub Alle20TageFarbeInteriorSetzen()
     ->*** Voraussetzung: eine Datumszelle ist markiert
     ->***
     ->*** Für diese Datumszelle und die Datumszellen im Abstand 19 Tage
     ->*** (also alle 20 Tage) wird her Zellehintergrung auf die ausgesuchte Farbe gesetzt
     ->***
     ->*** Trifft der Tag einen Sonnabend oder Sonntag wird der Tag verschoben,
     ->*** In Abhängigkeit der Kennung cVerschieben
     ->*** cVerschieben = 0 : keine Verschiebung
     ->*** cVerschieben = 1 : Verschieben auf den Montag danach
     ->*** cVerschieben = 2 : Verschieben auf den Freitag vorher
     ->***
     ->*** Die weitere Zählung bleibt aber bei 21 Tagen, d.h. wird der Tag verschoben
     ->*** wird der Zähler so für den nächsten zu kennzeichnenden Tag aufgesetzt,
     ->*** daß dieser von der verschiebung unberührt bleibt.
     ->*** (Wenn dies nicht erfolgt, folgen einem Montag nur noch Montage,
     ->***  einem Freitag nur noch Freitage)
      
      Dim ws As Worksheet
      Dim lZStart As Long, lSPStart As Long, lSPmax As Long
      Dim bIstDatumSP As Boolean, sp As Long, z As Long
      Dim sTxt As String, lCIndex As Long, lTZ As Long, lAnzTagVerschiebung As Long
      
      Set ws = ActiveSheet
      
     ->Eine Zelle markiert ?
      If Selection.Count <> 1 Then MsgBox Bitte nur eine Zelle markieren.: GoTo AUFRAEUMEN
      
     ->Datumszelle Zeile, Spalte
      lZStart = Selection.Row: lSPStart = Selection.Column
      
     ->Zeile prüfen
      If (lZStart < cZ_ERSTEZEILE) Or (lZStart > cZ_LETZTEZEILE) Then
        MsgBox Bitte eine Datums-Zelle selektieren.: GoTo AUFRAEUMEN
      End If
      
     ->Spalte prüfen
      bIstDatumSP = False
      For sp = cSP_ERSTEDATUMSSPALTE _
               To cSP_ERSTEDATUMSSPALTE + (cSP_ANZAHL_PROMONAT * (cMONATE_ANZAHL - 1)) _
               Step cSP_ANZAHL_PROMONAT
        If sp = lSPStart Then bIstDatumSP = True: Exit For
      Next
      If Not bIstDatumSP Then MsgBox Bitte eine Datums-Zelle selektieren.: GoTo AUFRAEUMEN
    
     ->Zelle prüfen
      If Not IsDate(ws.Cells(lZStart, lSPStart).Value) Then
        MsgBox Bitte eine Datums-Zelle mit Datum selektieren.: GoTo AUFRAEUMEN
      End If
      
     ->*** ist Datumszelle, also kann es jetzt losgehen
      lCIndex = cFARBINDEX
     ->Startzelle farbig, Tagezähler auf 0
      With ws.Cells(lZStart, lSPStart)
        .Interior.ColorIndex = lCIndex
        .Offset(0, 1).Interior.ColorIndex = lCIndex
        .Offset(0, 2).Interior.ColorIndex = lCIndex
      End With
      lTZ = 0       'Zähler Tage
      z = lZStart   'Zeile
      sp = lSPStart->Spalte
      lSPmax = cSP_ERSTEDATUMSSPALTE + (cSP_ANZAHL_PROMONAT * (cMONATE_ANZAHL - 1))
      Do
        z = z + 1
        If z > cZ_LETZTEZEILE Then
          z = cZ_ERSTEZEILE
          sp = sp + cSP_ANZAHL_PROMONAT
        End If
        If sp > lSPmax Then Exit Do
        If IsDate(ws.Cells(z, sp).Value) Then
          lTZ = lTZ + 1
          
          If cVERSCHIEBEN = 2 Then
           ->Wenn Sonnabend/Sonntag, dann verschieben auf den Freitag davor
           ->prüfen, ob Tag = Freitag und Zähler um 1 oder 2 vor Grenze
            If vbFriday = WeekDay(ws.Cells(z, sp).Value) Then
              If lTZ >= cTAGE_ALLE20 - 2 Then
                lAnzTagVerschiebung = lTZ - cTAGE_ALLE20
               ->Tageszähler auf Grenze setzen
                lTZ = cTAGE_ALLE20->
              End If
            End If
          End If
          
          If lTZ >= cTAGE_ALLE20 Then
            If cVERSCHIEBEN <> 1 Then
              
             ->normal behandeln
              With ws.Cells(z, sp)
                .Interior.ColorIndex = lCIndex
                .Offset(0, 1).Interior.ColorIndex = lCIndex
                .Offset(0, 2).Interior.ColorIndex = lCIndex
              End With
              lTZ = lAnzTagVerschiebung
              lAnzTagVerschiebung = 0
            Else
            
             ->wenn Sonnabend/Sonntag, dann auf Montag verschieben
              If vbSunday = WeekDay(ws.Cells(z, sp).Value) Then
               ->Sonntag -> Zähler um 1 erniedrigen
                lTZ = lTZ - 1
                lAnzTagVerschiebung = 1
              ElseIf vbSaturday = WeekDay(ws.Cells(z, sp).Value) Then
               ->Samstag -> Zähler um 2 erniedrigen
                lTZ = lTZ - 2
                lAnzTagVerschiebung = 2
              Else
               ->kein Samsatg/Sonntag -> Tag kennzeichnen
                With ws.Cells(z, sp)
                  .Interior.ColorIndex = lCIndex
                  .Offset(0, 1).Interior.ColorIndex = lCIndex
                  .Offset(0, 2).Interior.ColorIndex = lCIndex
                End With
                lTZ = lAnzTagVerschiebung
                lAnzTagVerschiebung = 0
              
              End If
            End If
          End If
        End If
      Loop
      
    AUFRAEUMEN:
      Set ws = Nothing
    End Sub
     
  6. Hallo Matjes,

    Toll ..............  mml

    Für deine Verbesserung meinen herzlichsten Dank.
    Ich war im Zweifel ob mein Anliegen überhaupt machbar wäre.  ???

    Aber nach deinem Motto:

    Denkst du dir es geht nichts mehr -
    kommt von irgendwo ein Lichtlein her
    ,

    sollte man doch keinen Zweifel hegen.

    Mit freundlichen Grüßen

    Odje
     
Die Seite wird geladen...

Im Kalender bestimmte Tage markieren - Ähnliche Themen

Forum Datum
Anzeige Kalenderübersicht fehlt! Windows 10 Forum 4. Aug. 2016
Outlook 2013 Kalender Beginn/Ende Zeiteinteilung Microsoft Office Suite 25. Apr. 2016
Outlook 2013 Kalender einfärben Microsoft Office Suite 18. Apr. 2016
Suche Proggramm um Kalenderdatei zu synchronisieren Software: Empfehlungen, Gesuche & Problemlösungen 26. Feb. 2016
Outlook 2013 Kalender - Alle Feiertage doppelt eingetragen Microsoft Office Suite 23. Dez. 2015