تعديل كود طباعة راس وتذييل الصفحة الى صفحات فردية وزوجية مختلفة

مصطفى محمود مصطفى · نوفمبر 17, 2015

السلام عليكم

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

هل يمكن تعديله او اي كود اخر يقوم بعمل راس وتذييل صفحة فردية واخرى زوجية تختلف احدهما عن الاخرى

شكرا للجميع وبارك الله في جهودكم الطيبة

(Private Sub Workbook_BeforePrint(Cancel As Boolean)
With ActiveSheet.PageSetup
.RightHeader = Sheets("Sheet1").Range("A1").Value & Chr(13) & Sheets("Sheet1").Range("A2").Value
.CenterHeader = Sheets("Sheet1").Range("b1").Value & Chr(13) & Sheets("Sheet1").Range("b2").Value
.LeftHeader = Sheets("Sheet1").Range("c1").Value & Chr(13) & Sheets("Sheet1").Range("c2").Value
.RightFooter = Sheets("Sheet1").Range("A3").Value & Chr(13) & Sheets("Sheet1").Range("A4").Value
.CenterFooter = Sheets("Sheet1").Range("b3").Value & Chr(13) & Sheets("Sheet1").Range("b4").Value
.LeftFooter = Sheets("Sheet1").Range("c3").Value & Chr(13) & Sheets("Sheet1").Range("c4").Value
End With
End Sub)

صفحات فردية وزوجية مختلفة.rar

**الـعيدروس** · نوفمبر 17, 2015

ارفق مثال عملي لما تريد

كما الملف عندك وحط بيانات وهميه

ليتم التطبيق عليه مع شرح مبسط

تحياتي

مصطفى محمود مصطفى · نوفمبر 17, 2015

شكرا لكم استاذ العيدروس للاستجابة السريعة جزاكم الله خيرا

ارفقت ملف وفيه شرح بسيط ان شاء الله تصل الفكرة التي اريد الوصول اليها

بارك الله في جهودكم الطيبة

راس وتذييل الصفحة.rar

**الـعيدروس** · نوفمبر 17, 2015

السلام عليكم

جرب هذا الكود

Sub Ali_Prnt()
Dim R           As Long
Dim Num         As Long
'**********************************************
On Error Resume Next
With ActiveSheet
    .PageSetup.PrintArea = .PageSetup.PrintArea
    ActiveWindow.View = xlPageBreakPreview
     For R = 1 To .HPageBreaks.Count + 1
        Num = Num + 1
        If Num Mod 2 <> 0 Then
            With .PageSetup
                 .RightHeader = Sheets("الاساسية").Range("A1").Value & Chr(13) & Sheets("الاساسية").Range("A2").Value
                 .RightFooter = Sheets("الاساسية").Range("A3").Value & Chr(13) & Sheets("الاساسية").Range("A4").Value
                 .CenterFooter = Sheets("الاساسية").Range("b3").Value & Chr(13) & Sheets("الاساسية").Range("b4").Value
            End With
                .PrintPreview
        Else
            With .PageSetup
                 .LeftHeader = Sheets("الاساسية").Range("c1").Value & Chr(13) & Sheets("الاساسية").Range("c2").Value
                 .LeftFooter = Sheets("الاساسية").Range("c3").Value & Chr(13) & Sheets("الاساسية").Range("c4").Value
            End With
                .PrintPreview
            End If
        Next R
End With
    ActiveWindow.View = xlNormalView
'**********************************************
On Error GoTo 0
End Sub

لاتنسى تحط علامة ' في كود حدث الطباعة

'Private Sub Workbook_BeforePrint(Cancel As Boolean)
'With ActiveSheet.PageSetup
'' على خليتين لكل واحدة يعني يمين خليتين يسار خليتين وسط خليتين لتذيل وراس الصفحة
'    .RightHeader = Sheets("الاساسية").Range("A1").Value & Chr(13) & Sheets("الاساسية").Range("A2").Value
'    .CenterHeader = Sheets("الاساسية").Range("b1").Value & Chr(13) & Sheets("الاساسية").Range("b2").Value
'    .LeftHeader = Sheets("الاساسية").Range("c1").Value & Chr(13) & Sheets("الاساسية").Range("c2").Value
'    .RightFooter = Sheets("الاساسية").Range("A3").Value & Chr(13) & Sheets("الاساسية").Range("A4").Value
'    .CenterFooter = Sheets("الاساسية").Range("b3").Value & Chr(13) & Sheets("الاساسية").Range("b4").Value
'    .LeftFooter = Sheets("الاساسية").Range("c3").Value & Chr(13) & Sheets("الاساسية").Range("c4").Value
'End With
'End Sub

تحياتي

تم تعديل نوفمبر 17, 2015 بواسطه الـعيدروس

مصطفى محمود مصطفى · نوفمبر 18, 2015

السلام عليكم

اخي الاستاذ العيدروس جزاكم الله خيرا

شكرا لكم على جهودكم ووقتكم الكود رائع

لكن لا اعرف الخلل بتنفيذي للكود ام يحتاج الى تعديل من شخصكم الكريم

يظهر لي في الصفحة الفرديةفي الرأس فقط المدرسة ولا يظهر جدول رقم 1 من الخلية B1-B2

اما تذييل الورقة الفردية يظهر كاملا ولا يوجد فيه خلل

اما راس وتذييل الصفحة الزوجية لايظهر فيها اي بيانات

بارك الله لكم في ذريتكم ورزقكم

تحياتي

تنفيذ الكود راس وتذييل الصفحة.rar

**الـعيدروس** · نوفمبر 18, 2015

جرب هذا التعديل

هذا التعديل بيتماشي مع ملفك كما هو بوضعه الحالي

Dim Sh As Worksheet
Sub Ali_Prnt()
Dim R           As Long
Dim Ar
Dim Rn As Range, Rn1 As Range
Set Sh = ActiveSheet
'**********************************************
On Error Resume Next
Application.EnableEvents = True
With Sh
II = .PageSetup.PrintArea
For R = 1 To .VPageBreaks.Count
Ro = .VPageBreaks(R).Location.Row
Cl = .VPageBreaks(R).Location.Column
Ar = .Range(.PageSetup.PrintArea)
Lr = UBound(Ar, 2) + 1
Rw = UBound(Ar, 1) + 1
Set Rn = .Range(Cells(Ro, 2), Cells(Rw, Cl - 1))
Set Rn1 = .Range(Cells(Ro, Cl), Cells(Rw, Lr))
            Ali_Rest
            With .PageSetup
                 .PrintArea = Rn.Address
                 .RightHeader = Sheets("الاساسية").Range("A1").Value & Chr(13) & Sheets("الاساسية").Range("A2").Value
                 .LeftHeader = Sheets("الاساسية").Range("B1").Value & Chr(13) & Sheets("الاساسية").Range("B2").Value
                 .RightFooter = Sheets("الاساسية").Range("A3").Value & Chr(13) & Sheets("الاساسية").Range("A4").Value
                 .CenterFooter = Sheets("الاساسية").Range("b3").Value & Chr(13) & Sheets("الاساسية").Range("b4").Value
                    End With
                .PrintPreview
            Ali_Rest
            With .PageSetup
                 .PrintArea = Rn1.Address
                 .LeftHeader = Sheets("الاساسية").Range("c1").Value & Chr(13) & Sheets("الاساسية").Range("c2").Value
                 .LeftFooter = Sheets("الاساسية").Range("c3").Value & Chr(13) & Sheets("الاساسية").Range("c4").Value
            End With
                .PrintPreview
        Next R
        .PageSetup.PrintArea = II
End With
Application.EnableEvents = False
'**********************************************
On Error GoTo 0
End Sub
Private Sub Ali_Rest()
With Sh
    With .PageSetup
            .RightHeader = ""
            .RightFooter = ""
            .CenterFooter = ""
            .LeftHeader = ""
            .LeftFooter = ""
    End With
End With
Set Sh = Nothing
End Sub

مصطفى محمود مصطفى · نوفمبر 19, 2015

السلام عليكم

اخي الاستاذ العيدروس وفقكم الله وانا تعبتك معاي واخذت من وقتك وجهدك الكثير

الله يعطيك الف عافية هذ التعديل ممتاز سلمت يمينك

ارجو من حضرتكم اذا ممكن والله ما بدي اغلبك لكن قدر المستطاع من وقتكم وجهدكم

الكود يعمل بشكل صحيح وددت ان شاء الله تعديل بسيط وهو

الورقة الفردية تمام وتسلم ايدك لكن الورقة الزوجية تكرر فيها اسم المدرسة في الراس وتكرر في التذييل اعداد التلاميذ وعدد الشعب

فاذا امكن عافاكم الله التعديل بعدم تكرار بيانات الصفحة الفردية في الصفحة الزوجية

لكم تحياتي

التكرارفي الصفحةالزوجية.rar

تم تعديل نوفمبر 19, 2015 بواسطه مصطفى محمود مصطفى

**الـعيدروس** · نوفمبر 19, 2015

السلام عليكم

لا عليك اخي مصطفى محمود

نحن بالخدمة طالما السؤال في حدود المعرفه

جرب المرفق

التكرارفي الصفحةالزوجية_111.rar

مصطفى محمود مصطفى · نوفمبر 19, 2015

السلام عليكم

اخي الاستاذ العيدروس (ابو نصار ) بارك الله في علمكم وزادكم علما ومعرفة

الله يعطيك الصحة والعافية ويرفع مقامكم

الكود اكثر من رائع

جهد ووقت كبير جعله الله في ميزان حسناتكم

لكم تحياتي

تم تعديل نوفمبر 19, 2015 بواسطه مصطفى محمود مصطفى

مصطفى محمود مصطفى · نوفمبر 20, 2015

السلام عليكم

اخي الاستاذ ابو نصار

عندما نقلت الكود الى ملفي الاصلي تغير وبدأ يضيف اوراق طباعة اكثر من الصفحتين

حملت فيديو لمشاهدة الحالة وابداء المساعدة

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

وفقكم الله

http://a7lashare.com/download/be77a7bf33.html

تم تعديل نوفمبر 20, 2015 بواسطه مصطفى محمود مصطفى

ياسر خليل أبو البراء · نوفمبر 20, 2015

أخي الكريم مصطفى

صراحة لم أتابع الموضوع منذ البداية ولكن اطلعت على ملف أخي الحبيب أبو نصار .. واطلعت على سؤالك الأخير بخصوص أن أوراق الطباعة أكثر من صفحتين

روح للتبويب View ثم اختر الأمر Page Break Preview ستجد خطوط زرقاء سميكة يمكنك من خلالها التحكم في الصفحات المطلوب طباعتها ..قم بسحب هذه الخطوط بحيث يتناسب مع طلبك

أرجو أن يكون المطلوب

مصطفى محمود مصطفى · نوفمبر 20, 2015

السلام عليكم

اخي الاستاذ ابو البراء حفظكم الله

قمت بعمل المطلوب كما شرحت وغيرته اكثر من مرة

لم تضبط معي عندما اشغل الكود تتغير اعدادات المعاينة كما في الفيديو المرفق

اما اذا عملتها يدوي يطبع صفحتين تمام ودون زيادة

اعتقد الكود يلغي معاينة الطباعة التي اعملها ويبدا من جديد

وكما تعلم استاذي انا اردت طباعة راس وتذييل الصفحات فردية تختلف عن الزوجية

لذلك قام الاستاذ ابو نصار بارسال الكود وهو رائع يقوم بادراج راس وتذييل الصفحة الفردية والزوجية تمام كما مطلوب

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

شكرا للمداخلة ونامل مساعدتي مع الاستاذ ابو نصار اذا امكن لكم ذلك

تحياتي

تم تعديل نوفمبر 20, 2015 بواسطه مصطفى محمود مصطفى

ياسر خليل أبو البراء · نوفمبر 20, 2015

قم بضبط منطقة الطباعة Print Area >> من خلال التبويب Page Layout ثم Print Area ثم حدد النطاق المطلوب العمل عليه ..

لا أدري ما المشكلة لديك ولا يمكن التخمين لأبعد من هذا الحد

إذا استمرت المشكلة يرجى إرفاق ملفك الأصلي بعد مسح البيانات الحساسة التي بالملف الأصلي

تقبل تحياتي

مصطفى محمود مصطفى · نوفمبر 20, 2015

السلام عليكم

اشكرك جزيل الشكر استاذ ياسر وبارك الله بك

ارفق الملف وفيه الكود وتعديل بسيط في الخلايا المطلوب ظهورها في الراس والتذييل مع اضافة كود

البداية والنهاية لحضرتكم لان الكود بطي فاردت ان يسرع لكن عدم توقف الكود عند الصفحتين جعلني ارسل لكم الملف

وان شاء الله ساجد عندكم او عند الاستاذ ابو نصار جزاه الله خيرا حلا للمشكلة

لكم تحياتي جميعا

طباعة راس وتذيل الصفحات الفردية والزوجية.rar

**الـعيدروس** · نوفمبر 20, 2015

اذا كان ملفك كجدول واحد الغي الحلقه التكراريه ليصبح الكود كالتالي

Sub Ali_Prnt()
Dim R           As Long
Dim Ar
Dim Rn As Range, Rn1 As Range
Dim Sh As Worksheet
'**********************************************
Call YK_Start
On Error Resume Next
Set Sh = ActiveSheet
With Sh
II = .PageSetup.PrintArea
'For R = 1 To .VPageBreaks.Count
Ro = .VPageBreaks(1).Location.Row
Cl = .VPageBreaks(1).Location.Column
Ar = .Range(.PageSetup.PrintArea)
Lr = UBound(Ar, 2) + 1
Rw = UBound(Ar, 1) + 1
Set Rn = .Range(Cells(Ro, 2), Cells(Rw, Cl - 1))
Set Rn1 = .Range(Cells(Ro, Cl), Cells(Rw, Lr))
            Ali_Rest
            With .PageSetup
                 .PrintArea = Rn.Address
                 .RightHeader = Sheets("الاساسية").Range("A5").Value & Chr(13) & Sheets("الاساسية").Range("B5").Value
                 .LeftHeader = Sheets("الاساسية").Range("A7").Value & Chr(13) & Sheets("الاساسية").Range("B7").Value
                 .RightFooter = Sheets("الاساسية").Range("A10").Value & Chr(13) & Sheets("الاساسية").Range("B10").Value
                 .CenterFooter = Sheets("الاساسية").Range("A11").Value & Chr(13) & Sheets("الاساسية").Range("b11").Value
            End With
                .PrintPreview
            Ali_Rest
            With .PageSetup
                 .PrintArea = Rn1.Address
                 .LeftHeader = Sheets("الاساسية").Range("A8").Value & Chr(13) & Sheets("الاساسية").Range("B8").Value
                 .LeftFooter = Sheets("الاساسية").Range("B6").Value & Chr(13) & Sheets("الاساسية").Range("A6").Value
                 .CenterHeader = Sheets("الاساسية").Range("A9").Value
            End With
                .PrintPreview
            Ali_Rest
'        Next R
        .PageSetup.PrintArea = II
End With
Set Sh = Nothing
Call YK_End
'**********************************************
On Error GoTo 0
End Sub
Private Sub Ali_Rest()
Call YK_Start
With Sheets("عام")
    With .PageSetup
            .LeftHeader = ""
            .RightHeader = ""
            .CenterHeader = ""
            .LeftFooter = ""
            .RightFooter = ""
            .CenterFooter = ""
    End With
End With
Call YK_End
End Sub

مصطفى محمود مصطفى · نوفمبر 20, 2015

السلام عليكم

الاخ الاستاذ ابو نصار

كود ممتاز ويعمل بشكل رائع على ملفي الاصلي

جعله الله في ميزان حسناتكم

وفقكم الله واعطاكم الصحة والعافية وحفظكم من كل سوء

تحياتي

تسجيل الدخول

تعديل كود طباعة راس وتذييل الصفحة الى صفحات فردية وزوجية مختلفة

الردود الموصى بها

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

من فضلك سجل دخول لتتمكن من التعليق

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

Important Information