summer adds months to sheet / pages Free Excel Macros (VBA) | Excel Programs

Copy Macro

'For online Excel courses click: https://www.excelsizeyeter.com/excelwithkenan.com/udemy_giris.php 
 
Sub Kalender_erstellen()
  Dim i As Integer, x As Integer, alt As Integer
  Dim WS As Worksheet
  Dim Jahr As Integer
  Jahr = InputBox("Bitte Das Jahr 4-stellig eingeben", "Jahresabfrage", _
    IIf(Month(Date) > 9, Year(Date) + 1, Year(Date)))
  alt = Application.SheetsInNewWorkbook 'alt auslesen
  Application.SheetsInNewWorkbook = 13 'verändern
  Workbooks.Add
  Application.SheetsInNewWorkbook = alt 'zurücksetzen
  For i = 1 To 12
    Set WS = Worksheets(i)
    With WS.[a1:E3]
      .HorizontalAlignment = xlCenter
      .MergeCells = True
      .Font.Name = "Arial"
      .Font.Size = 20
      .Font.Bold = True
      .Font.Italic = True
      .NumberFormat = "mmmm yyyy"
    End With
    
    WS.[a1] = DateSerial(Jahr, i, 1)
    WS.Name = Format(WS.[a1], "MMMM")
    WS.[A5:A36].NumberFormat = "DDD DD.MM.YY"
    WS.Columns(5).HorizontalAlignment = xlRight
    'Datum eintragen
    For x = 0 To 30
      If Month(WS.[a1] + x) = Month(WS.Cells(x + 6, 1)) Or x = 0 Then
        WS.Cells(x + 7, 1) = WS.[a1] + x
        If Weekday(WS.Cells(x + 7, 1)) = 1 Then _
            Range(WS.Cells(x + 7, 1), WS.Cells(x + 7, 5)).Interior.ColorIndex = 48
        If Weekday(WS.Cells(x + 7, 1)) = 7 Then _
            Range(WS.Cells(x + 7, 1), WS.Cells(x + 7, 5)).Interior.ColorIndex = 15
        If Weekday(WS.Cells(x + 7, 1)) = 2 Then WS.Cells(x + 7, 5) = _
            "KW " & DatePart("ww", WS.Cells(x + 7, 1), vbMonday, vbFirstFourDays)
        WS.Cells(x + 7, 1).Borders.Weight = xlThin
        With Range(WS.Cells(x + 7, 2), WS.Cells(x + 7, 5))
          .Borders(xlEdgeLeft).Weight = xlThin
          .Borders(xlEdgeTop).Weight = xlThin
          .Borders(xlEdgeBottom).Weight = xlThin
          .Borders(xlEdgeRight).Weight = xlThin
        End With
        'Feiertage eintragen und formatieren
        WS.Cells(x + 7, 2) = FeiertagCH(WS.Cells(x + 7, 1))
        If WS.Cells(x + 7, 2)  "" Then
          If Right(WS.Cells(x + 7, 2), 1) = "*" And _
            WS.Cells(x + 7, 2).Interior.ColorIndex = xlNone Then
            Range(WS.Cells(x + 7, 1), WS.Cells(x + 7, 3)).Interior.ColorIndex = 15
          Else
            Range(WS.Cells(x + 7, 1), WS.Cells(x + 7, 5)).Interior.ColorIndex = 48
          End If
        End If
      End If
    Next x
  Next i
  
  With Worksheets(13)
    .Name = "Übersicht"
    .PageSetup.Orientation = xlLandscape
    With .Columns("A:F")
      .ColumnWidth = 19.5
      ' weitere Formatierungen der Spalten
    End With
    For i = 1 To 6
      .Cells(2, i) = Format(DateSerial(0, i, 1), "MMMM")
      .Cells(20, i) = Format(DateSerial(0, i + 6, 1), "MMMM")
      Range(.Cells(2, i), .Cells(19, i)).BorderAround ColorIndex:=0, Weight:=xlThin
      Range(.Cells(20, i), .Cells(38, i)).BorderAround ColorIndex:=0, Weight:=xlThin
    Next i
  End With
End Sub

Function FeiertagCH(datum As Date)
Dim J As Integer
Dim O As Date
Dim D As Integer
J = Year(datum)
D = (((255 - 11 * (J Mod 19)) - 21) Mod 30) + 21
O = DateSerial(J, 3, 1) + D + (D > 48) + 6 - _
  ((J + J  4 + D + (D > 48) + 1) Mod 7)
Select Case datum
    Case Is = DateSerial(J, 1, 1)
        FeiertagCH = "Neujahr"
    Case Is = DateSerial(J, 1, 2)
        FeiertagCH = "Berchtoldstag*"
    Case Is = DateSerial(J, 3, 3)
        FeiertagCH = "Josefstag*"
    Case Is = DateAdd("D", -2, O)
        FeiertagCH = "Karfreitag"
    Case Is = O
        FeiertagCH = "Ostersonntag"
    Case Is = DateAdd("D", 1, O)
        FeiertagCH = "Ostermontag*"
    Case Is = DateSerial(J, 5, 1)
        FeiertagCH = "Maifeiertag*"
    Case Is = DateAdd("D", 39, O)
        FeiertagCH = "Auffahrt, Christi Himmelfahrt"
    Case Is = DateAdd("D", 49, O)
        FeiertagCH = "Pfingstsonntag"
    Case Is = DateAdd("D", 50, O)
        FeiertagCH = "Pfingstmontag"
    Case Is = DateAdd("D", 60, O)
        FeiertagCH = "Fronleichnam*"
    Case Is = DateSerial(J, 8, 1)
        FeiertagCH = "Bundesfeier"
    Case Is = DateSerial(J, 8, 15)
        FeiertagCH = "Mariae Himmelfahrt*"
    Case Is = DateSerial(J, 11, 1)
        FeiertagCH = "Allerheiligen*"
    Case Is = DateSerial(J, 12, 8)
        FeiertagCH = "Mariae Empfängnis*"
    Case Is = DateSerial(J, 12, 24)
        FeiertagCH = "Heilig Abend*"
    Case Is = DateSerial(J, 12, 25)
        FeiertagCH = "Weihnachtsfeiertag"
    Case Is = DateSerial(J, 12, 26)
        FeiertagCH = "Stefanstag"
    Case Is = DateSerial(J, 12, 31)
        FeiertagCH = "Silvester*"
Case Else
    FeiertagCH = ""
End Select
End Function

No	Macro Name
1	summer adds months to sheet / pages
2	adds months as sheet / pages and goes to that day
3	Adds months as a sheet / page and writes the days of the month and goes to the active month and day
4	inserts months as sheet / pages Specifies days in detail
5	Adds sheet / pages based on data in column A and writes data up to column D
6	1.pir copies 10 sheet / pages and adds .pir
7	add months as sheet / pages
8	if the sheet / page is blank, inserts the date in the footer and prints if not
9	writes the names of all sheet / pages from the active sheet / page and cell and adds a link to the sheet / pages
10	Inputbox add year as summer
11	excel operators hk
12	collects a1 values of all sheet / pages and reports
13	inserts sequential (ascending) sheet / pages
14	a macro that automatically deletes the following month-old sheet / pages before moving to the new month when the specified month is over
15	Adds a new sheet / page named month and year, together with the data a1: a5
16	perfectly deletes the menu to the right mouse and adds print print preview sheet / page structure
17	specifies in detail how many references the book contains (on new sheet / page)
18	list formulas on new sheet / page
19	specifies in detail how many formulas are in the book (on new sheet / page)
20	add sheet / pages as menus

Excel Free Macros (VBA)

Summer Adds Months To Sheet / Pages

Online Excel Courses

Services

How can we help you?

Subscribe to our Youtube Channel?

Keywords