Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.04.2024 19:22:16
Von exceltabelle in word per steuerelement temarker
16.04.2024 18:50:53
Fehlermeldung bei Code - Excel speichern mit Bez. aus Zelle
16.04.2024 17:18:01
Projektplan-Tabelle oder Gantt ohne Balken
16.04.2024 17:05:25
formatierten Text direkt in Zelle einfügen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1600to1604
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1600to1604
1600to1604
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Problem mit Schleife

Problem mit Schleife
15.01.2018 19:55:22
Johann
Hallo,
könnte bitte jemand bei folgendem Code helfen?
Die Schleife über die Monate funkt nicht.
Sub Spalten_weg()
For Monat = 1 To 12
With Sheets(MonthName(Monat))
For s = 1 To 4
Range("A1").End(xlToRight).Offset(, s).Select
If ActiveCell.Value = "" Then
ActiveCell.EntireColumn.Hidden = True
End If
Next s
End With
End Sub

Next Monat

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
zeige den Code von MonthName() ! o.T.
15.01.2018 20:06:07
MonthName()
Gruß Sepp

AW: zeige den Code von MonthName() ! o.T.
15.01.2018 20:08:48
MonthName()
Das ist der ganze Code.
Ziel ist es die nächsten leeren bis zu 4 Spalten nach dem end Datum des Monates auszublenden.
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
Application.ScreenUpdating = False
For Monat = 1 To 12
spalte = 5
With Sheets(MonthName(Monat))
.Range("A2:AM99").ClearContents
.Range("A2:AM99").Interior.ColorIndex = xlNone
.Range("A2:AM99").EntireColumn.Hidden = False
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
Application.ScreenUpdating = True
End Sub

Anzeige
AW: zeige den Code von MonthName() ! o.T.
15.01.2018 20:14:33
MonthName()
Hallo Johann,
und immer noch weiß ich nicht, was MonthName() macht bzw. was es zurückgibt!
Wie heißen denn deine Monatsblätter?
Gruß Sepp

AW: zeige den Code von MonthName() ! o.T.
15.01.2018 20:22:17
MonthName()
Entschuldige,
Die Blätter sind nach den Monaten
Januar - Dezember benannt.
AW: zeige den Code von MonthName() ! o.T.
15.01.2018 20:25:53
MonthName()
Hallo Johannes,
der Code kann so nie gelaufen sein!
Was soll den genau geschehen?
Gruß Sepp

Anzeige
AW: zeige den Code von MonthName() ! o.T.
15.01.2018 20:35:56
MonthName()
Mit diesem Code wird in die vorhandenen
Monate das jeweilige Datum eingetragen.
Die WE + Feiertage werden verschieden Markiert.
Da jedoch nicht jeder Monat selbe anzahl von Tagen hat,
habe ich nach dem 31.ten noch eine Spalte.
Nach Ablauf vom Code sollen die Leeren Spalten ausgeblendet werden.
Der Code funktioniert.
Allerdings schaffe ich das Ausblenden der leeren Spalten nicht.
Ich muss zugeben, dass ich an dieser Datei seit 2 Wochen sitze.
Ich bin eher schlecht als bescheiden. Meine Codes entstehen durch Schnippsel
aus Forensuchen :)
AW: zeige den Code von MonthName() ! o.T.
15.01.2018 20:42:01
MonthName()
Hallo Johannes,
ich weiß schon was der Code macht, nur ohne die Funktion MonthName() läuft er nicht!
Egal, hier ohne MonthName() und vier Spalten nach dem Monatsletzten werden ausgeblendet.
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 Long
Dim spalte As Long
jahr = 2018
Application.ScreenUpdating = False
For Monat = 1 To 12
  spalte = 5
  With Sheets(Format(DateSerial(jahr, Monat, 1), "MMMM"))
    With .Range("A:AM")
      .ClearContents
      .Interior.ColorIndex = xlNone
      .EntireColumn.Hidden = False
    End With
    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, vbMonday) < 6 Then
        With .Columns(spalte)
          .Interior.ColorIndex = xlNone
          .Font.ColorIndex = xlAutomatic
          .ColumnWidth = 6.71
        End With
      ElseIf Weekday(tag, vbMonday) = 6 Then
        With .Columns(spalte)
          .Interior.ColorIndex = 48
          .Font.Color = vbWhite
          .ColumnWidth = 4.69
        End With
      ElseIf Weekday(tag, vbMonday) = 7 Then
        With .Columns(spalte)
          .Interior.ColorIndex = 56
          .Font.Color = vbWhite
          .ColumnWidth = 4.69
        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).Resize(, 4).Hidden = True
    .Columns(spalte).NumberFormat = "DD DDD"
    .Rows(1).NumberFormat = "DD DDD"
  End With
Next Monat
Application.ScreenUpdating = True
End Sub

Gruß Sepp

Anzeige
AW: zeige den Code von MonthName() ! o.T.
15.01.2018 21:24:36
MonthName()
Vielen lieben Dank Sepp,
Ich musste deinen Code etwas abändern, weil in gewissen Zellen
der Inhalt bestehen bleiben sollte.
Allerdings finde ich dein Können echt TOP!!
In so kurzer Zeit einen langen Code schnell umgeschrieben obwohl nicht gekannt.
Leider besteht mein Problem jedoch immer noch.
Nun werden zwar die nächsten Spallten ausgeblendet, jedoch nicht geprüft ob diese Leer sind.
Könntest du da auch helfen bitte?
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 Long
Dim spalte As Long
jahr = 2018
Application.ScreenUpdating = False
For Monat = 1 To 12
spalte = 5
With Sheets(MonthName(Monat))
.Range("A2:AM99").ClearContents
.Range("E1:AJ1").ClearContents
.Range("A2:AM99").Interior.ColorIndex = xlNone
.Range("A2:AM99").EntireColumn.Hidden = False
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, vbMonday)

Anzeige
AW: zeige den Code von MonthName() ! o.T.
15.01.2018 21:34:33
MonthName()
Hallo Johann,
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 Long
Dim spalte As Long
jahr = 2018
Application.ScreenUpdating = False
For Monat = 1 To 12
  spalte = 5
  With Sheets(Format(DateSerial(jahr, Monat, 1), "MMMM"))
    With .Range("A2:AM99")
      .ClearContents
      .Interior.ColorIndex = xlNone
      .EntireColumn.Hidden = False
    End With
    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, vbMonday) < 6 Then
        With .Columns(spalte)
          .Interior.ColorIndex = xlNone
          .Font.ColorIndex = xlAutomatic
          .ColumnWidth = 6.71
        End With
      ElseIf Weekday(tag, vbMonday) = 6 Then
        With .Columns(spalte)
          .Interior.ColorIndex = 48
          .Font.Color = vbWhite
          .ColumnWidth = 4.69
        End With
      ElseIf Weekday(tag, vbMonday) = 7 Then
        With .Columns(spalte)
          .Interior.ColorIndex = 56
          .Font.Color = vbWhite
          .ColumnWidth = 4.69
        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
    For spalte = spalte To spalte + 4
      .Columns(spalte).Hidden = Application.CountA(.Columns(spalte)) = 0
    Next
    .Columns(spalte).NumberFormat = "DD DDD"
    .Rows(1).NumberFormat = "DD DDD"
  End With
Next Monat
Application.ScreenUpdating = True
End Sub

Gruß Sepp

Anzeige
AW: zeige den Code von MonthName() ! o.T.
15.01.2018 21:47:51
MonthName()
Diesmal habe ich deinen Code um die Range E1:AJ erweitert
und sonst komplett behalten.
Allerding macht er nur Januar.
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 Long
Dim spalte As Long
jahr = 2018
Application.ScreenUpdating = False
For Monat = 1 To 12
spalte = 5
With Sheets(Format(DateSerial(jahr, Monat, 1), "MMMM"))
With .Range("A2:AM99")
.ClearContents
.Interior.ColorIndex = xlNone
.EntireColumn.Hidden = False
End With
With .Range("E1:AJ1")
.ClearContents
.Interior.ColorIndex = xlNone
End With
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, vbMonday)

Anzeige
AW: zeige den Code von MonthName() ! o.T.
15.01.2018 21:55:27
MonthName()
Hallo Johannes,
das Datum geht maximal bis Spalte AI, + 4 Spalten ist AM, AJ ist dann wohl zu kurz gegriffen!
Wo stehen den die Daten die für das ausblenden der Spalten relevant sind?
Gruß Sepp

AW: zeige den Code von MonthName() ! o.T.
15.01.2018 21:58:10
MonthName()
Z.b. 28.02.2018 ist im Blatt Februar auf AF1
In jedem Blatt befinden sich Daten ab AK
AW: zeige den Code von MonthName() ! o.T.
15.01.2018 21:59:21
MonthName()
Hallo Johannes,
ich schrieb ja 'maximal'!
Ich will wissen, in welcher Zeile die Daten stehen!
Gruß Sepp

Anzeige
AW: zeige den Code von MonthName() ! o.T.
15.01.2018 23:33:35
MonthName()
Hallo Johannes,
da du dir die Infos aus der Nase ziehen lässt, hier mein letzter Versuch für Heute.
Vielleicht hast du ja Formeln in den Spalten K:N, dann so. 
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 Long
Dim spalte As Long
jahr = 2018
Application.ScreenUpdating = False
For Monat = 1 To 12
  spalte = 5
  With Sheets(Format(DateSerial(jahr, Monat, 1), "MMMM"))
    With .Range("E1:AJ99")
      .ClearContents
      .Interior.ColorIndex = xlNone
      .EntireColumn.Hidden = False
    End With
    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, vbMonday) < 6 Then
        With .Columns(spalte)
          .Interior.ColorIndex = xlNone
          .Font.ColorIndex = xlAutomatic
          .ColumnWidth = 6.71
        End With
      ElseIf Weekday(tag, vbMonday) = 6 Then
        With .Columns(spalte)
          .Interior.ColorIndex = 48
          .Font.Color = vbWhite
          .ColumnWidth = 4.69
        End With
      ElseIf Weekday(tag, vbMonday) = 7 Then
        With .Columns(spalte)
          .Interior.ColorIndex = 56
          .Font.Color = vbWhite
          .ColumnWidth = 4.69
        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"
    For spalte = spalte + 1 To spalte + 5
      .Columns(spalte).Hidden = Application.CountIf(.Columns(spalte), ">""") = 0
    Next
  End With
Next Monat
Application.ScreenUpdating = True
End Sub

Gruß Sepp

Anzeige
AW: zeige den Code von MonthName() ! o.T.
16.01.2018 13:44:25
MonthName()
Hallo Sepp,
ich danke dir recht herzlichst für deine bemühungen.
Ich habe mal ein Screenshot von der datei gemacht.
Mit dem letzten Code gehts leider noch nicht.
Userbild
@Sepp Vielen Dank
16.01.2018 14:28:54
Johann
Ich habe mein Problem in der For spalte gefunden.
Da spalte schon benutz wird habe ich diese in s umbenannt.
Jetzt werden die Spalten über alle Monate versteckt.
Leider ohne Abfrage ob in AG bis AJ etwas drin steht.
Blendet alle aus :)
Dieser gebastelte Code ohne Ahnung funzt nicht
For s = 33 To 36
.Columns(s).Value Next s
Dieser blendet alle 4 aus
For s = 33 To 36
.Columns(s).Hidden = Application.CountIf(.Columns(s), ">""") = 0
Next s
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige