Soru EXCEL 2010'da yazdırılan sayfa sayısına göre tarih ekleme.

[dgnbstnc]

Merhaba,

Haftalık olarak yazdırdığım bir excel tablom bulunmakta. Bazen 6 sayfa bazen ise 7 sayfa olarak yazdırıyorum.

Sormak istediğim bir sayfadan birden fazla sayfa yazdırdığım zaman excelde her sayfaya bir sonraki günün tarihini otomatik eklemek mümkün müdür?

Aynı sayfadan 7 kopya aldığım zaman. 1. kopyada 14/12/2021 2. kopyada 15/12/2021 3. kopyada 16/12/2021 gibi.

Teşekkür ederim.

 

[Ömer]

Merhaba,

VBA sayfasında BuÇalışmakitabı(ThisWorkbook) kod sayfasına ekleyiniz.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    
    Dim s, i As Integer
    
    s = Application.InputBox("Kaç Sayfa Yazdırayım", Type:=2)
    
    Application.EnableEvents = False
    
    For i = 1 To s
        ActiveSheet.PageSetup.RightHeader = Format(Date + i - 1, "dd.mm.yyyy")
        ActiveSheet.PrintOut
        'ActiveSheet.PrintPreview
    Next i
    
    Application.EnableEvents = True
    
    Cancel = True
    
End Sub

 

[dgnbstnc]

Merhaba,

Öncelikle ilginiz teşekkür ederim,

Bir kaç soru sormak isterim devamında,

1- Sağ üst header tarih yazıları küçük kaldığı için okumada güçlük çıkarıyor.

2- X bir sayıda kopya almak istediğimde x+2 kadar çıktı alıyor. Kaç sayfa yazdırayım = 4 girdiğimde yazıcı 12 adet çıktı veriyor. Herhangi başka bir çıktıda (Bahsi geçen excel dosyasından bağımsız) bu sorun yaşanmıyor.

Teşekkürler.

 

[Ömer]

Ben denediğimde kaç adet istediysem o kadar yazdırdı. Birde bu şekilde deneyin. Font ayarını Calibri-Bold-20 yaptım

Private Sub Workbook_BeforePrint(Cancel As Boolean)
  
    Dim s, i As Integer
  
    s = Application.InputBox("Kaç Sayfa Yazdırayım", Type:=2)
  
    On Error GoTo 10
  
    Application.EnableEvents = False
  
    For i = 1 To s
        ActiveSheet.PageSetup.RightHeader = "&""Calibri,Bold""&20" & """" & Format(Date + s - 1, "dd.mmm.yyyy") & """"
        ActiveSheet.PrintOut
        'ActiveSheet.PrintPreview
    Next i

    Cancel = True
  
10  Application.EnableEvents = True
Cancel = True
  
End Sub