Tarih Yazdırma

[karabali]

Değerli üstadlarım ; ekte göndermiş olduğum dosyada F1 hücresine istediğim bir ayın günlerine ait gün/ay/yıl şeklinde tarih yazdıracak ve herbir günün yazıcıdan çıktısını alacak bir makro arıyorum. Forumda sıralı yazdırma ile ilgili sayfayalara sayı vererek yazdıran bir makro buldum ama kendime uyarlayamadım..Yardımcı olacaklara şimdiden teşekkürler..

 

[Necdet]

Merhaba,

Umarım doğru anlamışımdır. Aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayınız.
AG2 hücresi değiştiğinde ilgili ayın tüm günlerini print edecektir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [AG2]) Is Nothing Then Exit Sub
Dim i       As Integer
Dim j       As Integer
Dim Ay      As Integer
Dim AyAdi   As String
Dim Aylar
Aylar = Array("", "OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
AyAdi = UCase(Replace(Replace(Target.Value, "i", "İ"), "ı", "I"))
For Ay = 0 To 12
    If Aylar(Ay) = AyAdi Then Exit For
Next Ay
If Ay > 12 Then
    MsgBox "Ay Adını Yanlış Yazmayınız....", vbCritical
    Exit Sub
End If
j = Day(DateSerial(Year(Date), Ay + 1, 0))  'Ayın Son Günü
For i = 1 To j
    Range("F1") = Format(DateSerial(Year(Date), Ay, i), "dd.mm.yyyy")
'    ActiveSheet.PrintPreview
    ActiveSheet.PrintOut
    Application.Wait (Now + TimeValue("0:00:1"))
Next i
End Sub