اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


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

هل يوجد كود لعمل Headea & footer للطباعة في الاكسل بحيث اذا قام اي شخص باضافتة من الضبط لا يتم قبوله ويتم عرض الذي في الكودفقط اثناء عرض الطباعة((واذا كان هذا الكود ممكن فهل يتمتع بنفس الخصائص من توسيط ويسار ويمين وغيرها))

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

ولكن استاذي العزيز كيف جعل الميكرو يعمل بمجرد فتح صفحة عرض الطباعة وعند تغيير((بيانات التذييل والترويسه من اعدادت عرض الطباعة)) ومحاولة الطباعة يتم طباعة مافي الميكرو وليس ما تم تغييره

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

لمنع التلاعب بإعداد الصفحة

استخدم الكود التالى :

ActiveSheet.PrintPreview False
* لاحظ أن الإكسل لا يفعل معاينة الطباعة إذا كان الشيت فارغا يعنى لا بد أن يكون بالشيت أية بيانات يمكنك وضعه فى حدث تنشيط الورقة
Private Sub Worksheet_Activate()

ActiveSheet.PrintPreview False

End Sub

تم تعديل بواسطه kemas
رابط هذا التعليق
شارك

  • 2 weeks later...

الاستاذ الفاضل كيماس

كيف يمكن ان اجعل الكود يعمل ويقوم بطباعة الترويسةاو التذييل التي انا قمت بتسجيلها في الميكرو حتى ولو قام اي شخص اخر بادخال ترويسه جديده من خلال ضبط الصفحة او معاينة الطباعة ((اي انه لو حاول اي شخص عمل ترويسهاو تذييل وبمجرد الضغط غلى زر الطباعة يعمل الميكرو ويتم طباعة الترويسة او التذييل التي انا قمت بتسجيلها على هيئة ميكرو)) اتمنى ان اكون وفقت في الشرح

تم تعديل بواسطه ولد المجرب
رابط هذا التعليق
شارك

السلام عليكم و رحمة الله

اخي ولد المجرب

اضافة لإقتراحات الاخ كيماس

جرب هذا الكود

حيث يقوم بتغيير رأس الصفحة و التذييل في الوسط الى اسم يحيى قبل الطباعة

جربه لعله يفيدك

 Private Sub Workbook_BeforePrint(Cancel As Boolean)

With ActiveSheet.PageSetup

    .CenterHeader = "Yahya"

    .CenterFooter = "Yahya1"

End With

End Sub 

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

الاستاذ الفاضل العزيز يحيى حسين اشكرك جزيل الشكر

وبالفعل هذا هو المطلوب

كما اشكر الاستاذ كيماس على مساعدته .

ابواحمد

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

  • 9 months later...

السلام عليكم

استاذي الحبيب عبدالله المجرب

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

والله اعلم


Private Sub Worksheet_Change(ByVal Target As Range)

Dim thded As HPageBreak

Dim rngCol As Range

Dim arow As Range

On Error Resume Next

For Each thded In ActiveWindow.SelectedSheets.HPageBreaks

thded.Delete

Next thded

Set rngCol = ActiveSheet.Range("a2:f" & Cells(Rows.Count, "a:f").End(xlUp))

Do

Set arow = rngCol(1)

Set rngCol = rngCol.ColumnDifferences(Comparison:=arow)

rngCol.Select

ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Range("a2").End(xlDown).Offset(2, 0)

Loop Until arow = rngCol(1)

End Sub

  • Like 1
رابط هذا التعليق
شارك

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

ستتمكن من اضافه تعليقات بعد التسجيل



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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information