Takvim Oluşturan Macro Programı

Takvim Oluşturma ile ilgili Macro programı aşağıdadır. 

Option Base 1

Public Sub TakvimOlustur()
 Dim YilNo As Integer
 Dim Aylar As Variant
 Range("A:H").Clear
 YilNo = InputBox("Takvim Yılı değerini giriniz.", "Yıl Girişi", Year(Date))
 AyNo = 1
 Range("A1").Select
 With Selection
  .Value = YilNo
  .Font.Bold = True
  .HorizontalAlignment = xlCenter
 End With
 IlkGun = DateSerial(YilNo, AyNo, 1)
 IlkHaftaninIlkGunuNo = Weekday(IlkGun, vbMonday)
 r = 1
 mr1 = 2
 Range("B1:H1").Value = (Array("Pazartesi", "Salı", "Çarşamba", "Perşembe", "Cuma", "Cumartesi", "Pazar"))
 Range("B1:H1").Font.Bold = True
 i = 0
 For w = 1 To 53
  r = r + 1
  For c = 2 To 8
   If r = 2 And c - 1 < IlkHaftaninIlkGunuNo Then
    c = c
   Else
    Tarih = IlkGun + i
    If DatePart("m", Tarih) <> AyNo Then
     mr2 = r
     Range("A" & mr1 & ":A" & mr2).Merge
     Aylar = Array("Ocak", "Şubat", "Mart", "Nisan", "Mayıs", "Haziran", "Temmuz", "Ağustos", "Eylül", "Ekim", "Kasım", "Aralık")
     Range("A" & mr1 & ":A" & mr2).Value = Aylar(AyNo)
     Range("A" & mr1 & ":A" & mr2).Select
     With Selection
      .Orientation = xlUpward
      .Font.Bold = True
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
     End With
     mr1 = r + 1
     r = r + 1
     AyNo = DatePart("m", Tarih)
    End If
    If DatePart("yyyy", Tarih) = YilNo Then
     Cells(r, c) = Tarih
     i = i + 1
    End If
   End If
  Next c
 Next w
 Range("A1").Select
End Sub