yılı yaz sayfalara ayları ekler Hazır Excel Makroları (VBA) | Excel Programları

Makroyu Kopyala

'Excel Makro (VBA) online eğitimleri için: https://www.excelsizeyeter.com/excelsizeyeter.com/udemy_giris.php adresine tıklayınız. Bir eğitim alana bir eğitim bedavadır. İkinci eğitim olarak Excel, Excel pratik çözümler, finans eğitimleri vb. alabilirsiniz. 
 
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	Makro Adı
1	yılı yaz sayfalara ayları ekler
2	Inputbox yılı yaz, ayları sayfa olarak eklesin
3	ayları sayfa olarak ekler ayın günlerini de yazar ve aktif ay ve güne gider
4	forma otomatik resim getirme
5	excelde kendi eklenti ve fonksiyonlarınızı oluşturun
6	Özel Sayfaları Yazdır: Yazdırma seçeneklerinden ayarı kullanmak yerine, bu kodu, özel sayfa aralığı yazdırmak için kullanabilirsiniz. 5 ila 10 arasındaki sayfaları yazdırmak istediğinizi varsayalım. Sadece bu VBA kodunu çalıştırmanız ve başlangıç sayfası ve bitiş sayfasını girmeniz yeterlidir.
7	menü çubuğunun silinmesi ve özel bir menünün oluşturulması
8	ayları sayfa olarak ekler günleri ayrıntılı olarak belirtir
9	aktif sayfa ve hücreden itibaren tüm sayfaların isimlerini yazar ve sayfalara link ekler
10	ilgili sayfaya gitme
11	a1'de adı yazan sayfayı açmak
12	değişen hücreleri göster
13	listbox ve combobox'a veri girmek
14	takvimi sayfaya yazar(yılı değiştiriniz)
15	mükemmel sağ fareye menüsünü siler ve yazdır, baskı önizle, sayfa yapısını ekler
16	aktif sayfada yazı yaz tarih ve saat,dakika,saniyesi ile açıklama ekler ve açıklamaları siler
17	Dosyayı kim açtı 2
18	Mesaj kutusu (MsgBox) nasıl kullanılır ve detayları (butonlar, parametreler)
19	değişen hücreleri gösterme
20	eğer sayfa boş ise alt bilgiye tarihi ekler değilse ekleyer ve yazdırır

Excel Hazır Makrolar (VBA)

Yılı Yaz Sayfalara Ayları Ekler

Robotik Kodlama

Hizmetler

Size nasıl yardımcı olabiliriz?

Youtube Kanalımıza Abone Oldunuz mu?

Anahtar Kelimeler