Hallo,

ich habe hier einen vba Code für einen Kalender.

Ich möchte aber gerne die Tage senkrecht haben. z:b: in Spalte A

Ich schaffe es einfach nicht.

Kann mir jemand helfen?

Hier der Code:

Option Explicit

Sub Monat_anlegen()
'legt für den aktuellen Monat einen Kalender an
Dim Jahr As String, neuerMonat As String
Dim Monat As Integer, Tag As Integer, AnzTage As Integer
Dim d As Date
Dim wks As Worksheet

On Error GoTo Fehler

Jahr = Year(Date)
Monat = Month(Date)

'Anzahl Tage des aktuellen Monats
AnzTage = DateSerial(Year(Now), Month(Now) + 1, 1) _
        - DateSerial(Year(Now), Month(Now), 1)

neuerMonat = Format(Date, "mmm. yy")

'prüfen ob Tabelle schon vorhanden ist
For Each wks In ThisWorkbook.Worksheets
    If wks.name = neuerMonat Then
        MsgBox ("Tabelle ist für diesen Monat schon vorhanden" _
                & vbNewLine & vbNewLine & wks.name)
        Worksheets(wks.name).Visible = True
        Worksheets(wks.name).Activate
        Exit Sub
    End If
Next wks

'neue Monatstabelle anlegen
   Worksheets.Add After:=Worksheets(Worksheets.Count)
   ActiveSheet.name = neuerMonat
     
   Range("D1:AH2").Interior.ColorIndex = 35
   Range("D1:AH1").NumberFormat = "d"
   Range("D1:AH2").HorizontalAlignment = xlCenter
   Range("D2:AH2").NumberFormat = "ddd"
   
   For Tag = 1 To AnzTage
     With Cells(1, Tag + 3)
       d = DateSerial(Jahr, Monat, Tag)
           .Value = d
                'prüfen ob Sa / So wenn ja Hintergrundfarbe grün
                If Weekday(d) = 1 Or Weekday(d) = 7 Then
                    Range(Cells(3, Tag + 3), (Cells(40, Tag + 3))).Interior.ColorIndex = 35
                End If
            Cells(2, Tag + 3) = d
       End With
   Next Tag
     
     
Columns("D:AH").ColumnWidth = 3
Cells(3, 1).Activate


Exit Sub

Fehler:

    MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
    & "Beschreibung: " & Err.Description _
    , vbCritical, "Fehler"
End Sub

Besten Dank

Günther