Microsoft Excel

Herbers Excel/VBA-Archiv

Wochenende hervorheben


Betrifft: Wochenende hervorheben von: Johann Esau
Geschrieben am: 15.01.2018 16:27:08

Hallo Liebe Gemeinde,
ich habe es selbst ca. 3 Std probiert und komme nicht drauf.
Im Nachfolgenden Code wird mein Kalender erstellt. Allerdings
möchte ich die Wochenenden unterschiedlich Formatieren dafür habe ich einen
weiteren Code erstellt.
Leider Kann ich diesen nicht in den Kalender_erstellen integrieren.
Habt Ihr eine Idee?

Sub Kalender_erstellen()
  Dim tag As Long
  Dim Monat As Integer
  Dim jahr As Integer
  Dim ersterTag As Date
  Dim letzterTag As Date
  Dim zeile As Integer
  Dim spalte As Integer
  jahr = 2018
  
  For Monat = 1 To 12
    spalte = 5
    With Sheets(MonthName(Monat))
      '.Cells.Clear
      zeile = 1
      ersterTag = CDate("01." & Monat & "." & jahr)
      letzterTag = DateSerial(Year(ersterTag), Month(ersterTag) + 1, 0)
      .Cells(zeile, spalte) = ersterTag
        For tag = ersterTag To letzterTag
        .Cells(zeile, spalte) = tag

'Hier möchte ich den Code einfügen. Probeweise die nächste Zeile vom Or getrennt und etwas  _
umgeschrieben. Jedoch bekomme ich nur fehlermeldungen.
        
        If Weekday(tag) = 1 Or Weekday(tag) = 7 Then     
            .Cells(zeile, spalte).Interior.Color = vbRed
        End If
        Select Case tag
                Case DateSerial(Year(tag), 1, 1) 'Neujahr
                      .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case DateSerial(Year(tag), 1, 6) 'Hl. drei Könige
                  .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case Ostern(Year(tag)) - 2  'Karfreitag
                   .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case Ostern(Year(tag))  'Ostersonntag
                   .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case Ostern(Year(tag)) + 1  'Ostermontag
                   .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case DateSerial(Year(tag), 5, 1)    'Maifeiertag
                   .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case Ostern(Year(tag)) + 39 'Christi Himmelfahrt
                   .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case Ostern(Year(tag)) + 49    'Pfingstsonntag
                    .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case Ostern(Year(tag)) + 50    'Pfingstmontag
                    .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case Ostern(Year(tag)) + 60    'Fronleichnam
                    .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case DateSerial(Year(tag), 8, 15)   'Maria Himmelfahrt
                    .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case DateSerial(Year(tag), 10, 3)   'Tag der D. Einheit
                    .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case DateSerial(Year(tag), 11, 1)   'Allerheiligen
                    .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case DateSerial(Year(tag), 12, 24)  'Heiliger Abend
                   .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case DateSerial(Year(tag), 12, 25)  '1. Weihnachtstag
                    .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case DateSerial(Year(tag), 12, 26)  '2. Weihnachtstag
                   .Cells(zeile, spalte).Interior.Color = vbYellow
                
                Case DateSerial(Year(tag), 12, 31)  'Sylvester
                   .Cells(zeile, spalte).Interior.Color = vbYellow
                
                End Select
                spalte = spalte + 1
        Next tag
      .Columns(spalte).NumberFormat = "DD DDD"
      .Rows(1).NumberFormat = "DD DDD"
    End With
  Next Monat
End Sub
Sub WE_einfärben()

     For sp = 5 To 35
      
      If Weekday(Cells(1, sp).Value, 2) = 6 Then
         With Columns(sp)
             .Interior.ColorIndex = 48
             .Font.Color = vbWhite
             .ColumnWidth = 4.69
          End With
      End If
      If Weekday(Cells(1, sp).Value, 2) = 7 Then
         With Columns(sp)
             .Interior.ColorIndex = 56
             .Font.Color = vbWhite
             .ColumnWidth = 4.69
         End With
      End If
     Next
     
 End Sub

  

Betrifft: AW: Wochenende hervorheben von: ChrisL
Geschrieben am: 15.01.2018 16:47:41

Hi

      If Weekday(tag) = 1 Then
         With .Cells(zeile, spalte)
             .Interior.ColorIndex = 48
             .Font.Color = vbWhite
             .ColumnWidth = 4.69
          End With
      End If
      If Weekday(tag) = 7 Then
         With .Cells(zeile, spalte)
             .Interior.ColorIndex = 56
             .Font.Color = vbWhite
             .ColumnWidth = 4.69
         End With
      End If

cu
Chris


  

Betrifft: AW: Wochenende hervorheben von: Johann Esau
Geschrieben am: 15.01.2018 17:05:54

Vielen lieben Dank Chris,

der Code funktioniert super!
Kannst du mir bitte schreiben wie ich die ganze Spalte so formatieren kann?
(von den Wochenenden)

Danke im voraus


  

Betrifft: AW: Wochenende hervorheben von: ChrisL
Geschrieben am: 15.01.2018 17:07:10

Hi

ersetze
With .Cells(zeile, spalte)
durch
With .Columns(spalte)

cu
Chris


  

Betrifft: AW: Wochenende hervorheben von: Johann Esau
Geschrieben am: 15.01.2018 17:21:23

Genial :)))

Vielen Dank!
Klappt wunderbar.


  

Betrifft: AW: Wochenende hervorheben von: Johann Esau
Geschrieben am: 15.01.2018 18:00:05

Hallo Chris,

darf ich dich nochmal was fragen?

Ich wollte noch befor das Markro alles erledigt dank dir,
die Inhalte löschen.

In dem Code wird nur der Inhalt vom Januar gelöscht.
Obwohl der Code zum Löschen zu erst dran ist sind nun die Spalten von den
Wochenenden gelöscht.

Sub Kalender_erstellen()
  Dim tag As Long
  Dim Monat As Integer
  Dim jahr As Integer
  Dim ersterTag As Date
  Dim letzterTag As Date
  Dim zeile As Integer
  Dim spalte As Integer
  jahr = 2018
  
  For Monat = 1 To 12
    spalte = 5
    With Sheets(MonthName(Monat))
      Range("E2:AI99").Clear  'dies habe ich eingefügt
      zeile = 1
      ersterTag = CDate("01." & Monat & "." & jahr)
      letzterTag = DateSerial(Year(ersterTag), Month(ersterTag) + 1, 0)
      .Cells(zeile, spalte) = ersterTag
        For tag = ersterTag To letzterTag
        .Cells(zeile, spalte) = tag
        If Weekday(tag) = 1 Then
         With .Columns(spalte)
             .Interior.ColorIndex = 56
             .Font.Color = vbWhite
             .ColumnWidth = 4.69
          End With
      End If
      If Weekday(tag) = 7 Then
         With .Columns(spalte)
             .Interior.ColorIndex = 48
             .Font.Color = vbWhite
             .ColumnWidth = 4.69
         End With
      End If
      If Weekday(tag) = 2 Or Weekday(tag) = 3 Or Weekday(tag) = 4 Or Weekday(tag) = 5 Or  _
Weekday(tag) = 6 Then
         With .Columns(spalte)
             .Interior.ColorIndex = xlNone
             .Font.ColorIndex = xlAutomatic
             .ColumnWidth = 6.71
         End With
      End If
        Select Case tag
                Case DateSerial(Year(tag), 1, 1) 'Neujahr
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                Case DateSerial(Year(tag), 1, 6) 'Hl. drei Könige
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case Ostern(Year(tag)) - 2  'Karfreitag
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case Ostern(Year(tag))  'Ostersonntag
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case Ostern(Year(tag)) + 1  'Ostermontag
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case DateSerial(Year(tag), 5, 1)    'Maifeiertag
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case Ostern(Year(tag)) + 39 'Christi Himmelfahrt
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case Ostern(Year(tag)) + 49    'Pfingstsonntag
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case Ostern(Year(tag)) + 50    'Pfingstmontag
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case Ostern(Year(tag)) + 60    'Fronleichnam
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case DateSerial(Year(tag), 8, 15)   'Maria Himmelfahrt
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case DateSerial(Year(tag), 10, 3)   'Tag der D. Einheit
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case DateSerial(Year(tag), 11, 1)   'Allerheiligen
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case DateSerial(Year(tag), 12, 24)  'Heiliger Abend
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case DateSerial(Year(tag), 12, 25)  '1. Weihnachtstag
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case DateSerial(Year(tag), 12, 26)  '2. Weihnachtstag
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                Case DateSerial(Year(tag), 12, 31)  'Sylvester
                    With .Columns(spalte)
                        .Interior.ColorIndex = 56
                        .Font.Color = vbWhite
                        .ColumnWidth = 4.69
                    End With
                
                End Select
                spalte = spalte + 1
        Next tag
      .Columns(spalte).NumberFormat = "DD DDD"
      .Rows(1).NumberFormat = "DD DDD"
    End With
  Next Monat
End Sub



  

Betrifft: AW: Wochenende hervorheben von: ChrisL
Geschrieben am: 15.01.2018 18:03:13

Hi

Ohne Punkt gilt der Befehl nur für das aktive Blatt.

.Range("E2:AI99").Clear

cu
Chris


  

Betrifft: AW: Wochenende hervorheben von: Johann Esau
Geschrieben am: 15.01.2018 18:50:39

Vielen Dank Chris.

Top :)


Beiträge aus dem Excel-Forum zum Thema "Wochenende hervorheben"