Makroyla Üstbilgi ve Altbilgi Düzenleme

[huseyinvurkan]

Merhaba Arkadaşlar. Değişik isimlerden oluşan sayfaların bulunduğu Kazanım Değerlendirme Çizelgesi çalışması yapıyorum. Bu çalışmada aşağıdaki makroyu her sayfada ayrı ayrı çalıştırarak üst ve alt bilgileri düzenliyorum. Bu ise oldukça zaman alıyor. Şimdi bu makroyu değiştirip bir tuşa atayarak bir tıklamada bütün sayfaların üst ve alt bilgilerini tek seferde değiştirebilir miyim? Teşekkürler.

Sub alt_üst()
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&""Times New Roman,Kalın""&26" & Sayfa16.Range("E4") & " " & Sayfa16.Range("E2") & " " & Sayfa16.Range("B2") & " " & Sayfa16.Range("E10") & " " & Sayfa16.Range("O1")
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&P"
.RightFooter = "&""Times New Roman,Kalın""&12" & Sayfa16.Range("E8") & Chr(10) & Sayfa16.Range("E10") & " " & Sayfa16.Range("B8")
End With
Application.PrintCommunication = True
End Sub

 

[turist]

Sub alt_üst()
Dim sayfa As Worksheet
Application.ScreenUpdating = False
  For Each sayfa In Worksheets
With sayfa.PageSetup
.LeftHeader = ""
.CenterHeader = "&""Times New Roman,Kalın""&26" & Sayfa16.Range("E4") & " " & Sayfa16.Range("E2") & " " & Sayfa16.Range("B2") & " " & Sayfa16.Range("E10") & " " & Sayfa16.Range("O1")
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&P"
.RightFooter = "&""Times New Roman,Kalın""&12" & Sayfa16.Range("E8") & Chr(10) & Sayfa16.Range("E10") & " " & Sayfa16.Range("B8")
End With
Next
Application.PrintCommunication = True
Application.ScreenUpdating = True
End Sub

Kodu, ThisWorkbook (Bu ÇalışmaKitabı) kısmına koyun ve çalıştırın.

 

[huseyinvurkan]

Sayın turist verdiğiniz kodlar işimi gördü teşekkür ederim. Kullandığım sayfalardaki formüller biraz yavaşlatıyor ama halledebileceğimi zannediyorum. Elinize sağlık