كود راس وتذييل ورقة العمل لا يعمل على جميع الاوراق

[مصطفى محمود مصطفى]

السلام عليكم

كود راس وتذييل ورقة العمل يعمل على ورقة البيانات فقط

ارجو مساعدتي لجعله يعمل على جميع اوراق العمل

وفقكم الله

 

جلوس الطلبة.rar

[omar elhosseini]

الا خ مصطفى محمود مصطفى

 

استخدم هذا الكود قبل الطباعة

 

Sub CopyHeadersFooters()
'
Dim Sh As Worksheet
Sheets("البيانات").Select
With ActiveSheet.PageSetup
    lh = .LeftHeader
    ch = .CenterHeader
    rh = .RightHeader
    lf = .LeftFooter
    cf = .CenterFooter
    rf = .RightFooter
End With
For Each Sh In Worksheets
    With Sh.PageSetup
        .LeftHeader = lh
        .CenterHeader = ch
        .RightHeader = rh
        .LeftFooter = lf
        .CenterFooter = cf
        .RightFooter = rf
    End With
Next
'
End Sub
 

 

[مصطفى محمود مصطفى]

السلام عليكم 

شكرا اخي  عمر الحسيني

جربت ولم يفلح بالتغيير المطلوب

Sub CopyHeadersFooters()
'
Dim Sh As Worksheet
Sheets("البيانات").Select
With ActiveSheet.PageSetup
    lh = .LeftHeader
    ch = .CenterHeader
    rh = .RightHeader
    lf = .LeftFooter
    cf = .CenterFooter
    rf = .RightFooter
End With
For Each Sh In Worksheets
    With Sh.PageSetup
        .LeftHeader = lh
        .CenterHeader = ch
        .RightHeader = rh
        .LeftFooter = lf
        .CenterFooter = cf
        .RightFooter = rf
    End With
Next
'

ActiveWindow.SelectedSheets.PrintPreview

If MsgBox("هل تود الطباعة بعد المعاينة ؟", vbYesNo + vbQuestion, "طباعة") = vbYes Then ActiveSheet.PrintOut

End Sub

 

[عبدالسلام ابوالعوافي]

Sub UpdateFooter_Header1()
    Dim SH As Worksheet
    For Each SH In Worksheets
    With SH
    
        .PageSetup.RightHeader = Sheets("البيانات").Range("Q3").Value & Chr(13) & Range("Q4").Value
        .PageSetup.CenterHeader = Sheets("البيانات").Range("P1").Value & Chr(13) & Range("R1").Value
        .PageSetup.LeftHeader = Sheets("البيانات").Range("Q5").Value & Chr(13) & Range("Q6").Value
        .PageSetup.RightFooter = Sheets("البيانات").Range("A1000").Value
        .PageSetup.CenterFooter = Sheets("البيانات").Range("b1000").Value
        .PageSetup.LeftFooter = Sheets("البيانات").Range("c1000").Value
    End With
    Next

End Sub

 

[omar elhosseini]

الا خ مصطفى محمود مصطفى

اخي انا اعمل علي اوفيس 11

وهو يعمل جيد

تم تعديل مايو 29, 2016 بواسطه عمر الحسيني

[مصطفى محمود مصطفى]

السلام عليكم

اخي عمر الحسيني بارك الله بكم , انا خبرتي قليلة ويمكن لم اقوم بتطبيقه بالشكل الصحيح اشكر تعاونك معي وفقكم الله

اخي عبد السلام ابو العوافي  جزاكم الله خيرا .كود رائع ويعمل بشكل صحيح وفقكم الله

شكرا لتعاونكم معي