أكاديمية الصقر للتدريب

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


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





تعديل كود لوضع header ,footet

الاخوة الافاضل قمت بتسجيل ماكرو لعمل Header,Footer احتاج تعديله ليعمل تلقائيا بحيث يوضع بالحدث thisworkbook لعمل header ..



23-07-2020 11:07 مساء
omhamzh
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-05-2020
رقم العضوية : 19308
المشاركات : 137
الجنس : أنثى
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 225
 offline 

الاخوة الافاضل
قمت بتسجيل ماكرو لعمل Header,Footer
احتاج تعديله ليعمل تلقائيا بحيث
يوضع بالحدث thisworkbook
لعمل header وايضا عمل Footer
ادراج التاريخ فى Footer وعدد الاوراق
بحيث تكون بكل الاوراق لان عملها يدويا مع كبر الملف امر مرهق
بارك الله فيكم كل عام وانتم بخير
Sub header()
'
' header Macro
'

'
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "" & Chr(10) & "&""-,Bold""&12بسم الله الرحمن الرحيم"
        .RightHeader = "&""-,Bold""الحمد لله   "
        .LeftFooter = ""
        .CenterFooter = "" & Chr(10) & "&""-,Bold""&12فى حفظ الله" & Chr(10) & "&P"
        .RightFooter = "&D"
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
End Sub

 
 
 
  header.xlsm   تحميل xlsm مرات التحميل :(5)
الحجم :(15.886) KB


24-07-2020 06:27 صباحا
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif تعديل كود لوضع header ,footet
السلام عليكم
في الرابط التالي شرح لكيفيفة عمل حلقة تكرارية حول أوراق العمل في المصنف وداخل الحلقة التكرارية يمكنك تنفيذ ما شئتي من أوامر
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب

24-07-2020 08:59 صباحا
مشاهدة مشاركة منفردة [2]
omhamzh
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-05-2020
رقم العضوية : 19308
المشاركات : 137
الجنس : أنثى
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 225
 offline 
look/images/icons/i1.gif تعديل كود لوضع header ,footet
بارك الله فيك استاذنا

24-07-2020 09:17 صباحا
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif تعديل كود لوضع header ,footet
بارك الله فيكي أختي الكريمة
الرجاء وضع ما توصلتي إليه بعد معرفة كيفية عمل حلقة تكرارية لتقييم الكود وإبداء الملاحظات من قبل الأخوة الأعضاء.

24-07-2020 09:39 صباحا
مشاهدة مشاركة منفردة [4]
omhamzh
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-05-2020
رقم العضوية : 19308
المشاركات : 137
الجنس : أنثى
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 225
 offline 
look/images/icons/i1.gif تعديل كود لوضع header ,footet
شرح ممتاز استاذ ياسر انا نفذت جزء الاول من الحلقة التكرارية واضفت له الماكرو الذى قمت بتسجيله ولكن الماكرو توقف
وهذا ما توصلت اليه
Sub Test()
    Dim ws As Worksheet, sh As Worksheet
    Application.PrintCommunication = False
    Application.ScreenUpdating = False
        Set sh = ThisWorkbook.Worksheets("Sheet1")
            For Each ws In ThisWorkbook.Worksheets
            If ws.Name <> sh.Name Then
                Debug.Print ws.Name
                         End If
        Next ws
        
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "" & Chr(10) & "&""-,Bold""&12ÈÓã Çááå ÇáÑÍãä ÇáÑÍíã"
        .RightHeader = "&""-,Bold""ÇáÍãÏ ááå   "
        .LeftFooter = ""
        .CenterFooter = "" & Chr(10) & "&""-,Bold""&12Ýì ÍÝÙ Çááå" & Chr(10) & "&P"
        .RightFooter = "&D"
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.ScreenUpdating = True
    Application.PrintCommunication = True
    
End Sub


حفظكم الله

24-07-2020 11:12 صباحا
مشاهدة مشاركة منفردة [5]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif تعديل كود لوضع header ,footet
المفترض أنه ما بين سطري الحلقة التكرارية توضع الأوامر المطلوبة تنفيذها على كل ورقة عمل
راجعي الكود التالي (لم أجربه ..)
Sub Test()
    Dim ws As Worksheet, sh As Worksheet
    Application.ScreenUpdating = False
        Set sh = ThisWorkbook.Worksheets("Sheet1")
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name <> sh.Name Then
                With ws.PageSetup
                    .CenterHeader = "" & Chr(10) & "&""-,Bold""&12بسم الله الرحمن الرحيم"
                    .RightHeader = "&""-,Bold""الحمد لله   "
                    .CenterFooter = "" & Chr(10) & "&""-,Bold""&12فى حفظ الله" & Chr(10) & "&P"
                    .RightFooter = "&D"
                End With
            End If
        Next ws
    Application.ScreenUpdating = True
End Sub

24-07-2020 11:22 مساء
مشاهدة مشاركة منفردة [6]
omhamzh
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-05-2020
رقم العضوية : 19308
المشاركات : 137
الجنس : أنثى
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 225
 offline 
look/images/icons/i1.gif تعديل كود لوضع header ,footet
مشكور اخى استاذ ياسر
للاسف لم يعمل
تعبك مشكوووووووووور جدا 
بارك الله فيك




الكلمات الدلالية
,footet ، header ، لوضع ، تعديل ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 03:10 صباحا