12- كود نسخ Footer لجميع شيتات الاكسل اللى تختارها بضغط زر مع تثبيت الكود كإيقونة فى كل شيتات الاكسل

الاكسل
تعلم الاكسل
تعليم الاكسل
شرح برنامج الاكسل
نسخ الفوتر لشيتات الاكسل
فوتر
custom footer
footer
excel
للحصول على الأضافة مدى الحياة تواصل معانا على :-
Mobile : [phone]
Email : [e-mail]
/ @quantitiessurveying
رابط الاشتراك فى القناة
/ 1344832723089730
جروب الفيس بوك الخاص بالقناة
• دورة VBA EXCEL لمهندسي...
دورة الفيجول بيسك لمهندسين المكتب الفنى او التنفيذ
• برنامج حصر الحديد الكا...
ملف اكسل جاهز لحصر جميع اشكال الحديد مع رسم اشكال الحديد اتوماتيكيا وكتابة الاطوال اتوماتيكيا

[@QuantitiesSurveying]

Sub CopyFooterToSelectedFiles() Dim mainWorkbook As Workbook Dim selectedFiles As Variant Dim i As Integer Dim ws As Worksheet Dim mainFooterLeft As String Dim mainFooterRight As String Dim mainFooterCenter As String Dim wb As Workbook Application.ScreenUpdating = False Set mainWorkbook = ThisWorkbook If mainWorkbook.Sheets.Count = 0 Then MsgBox "لا توجد أوراق عمل في الملف المفتوح.", vbExclamation Exit Sub End If With ActiveSheet.PageSetup mainFooterLeft = "&16" & .LeftFooter ' تعيين سمك الخط إلى 16 mainFooterRight = "&16" & .RightFooter ' تعيين سمك الخط إلى 16 mainFooterCenter = "&16" & .CenterFooter ' تعيين سمك الخط إلى 16 End With If mainFooterLeft = "" And mainFooterRight = "" And mainFooterCenter = "" Then MsgBox "لا يوجد نص في الـFooter للملف المفتوح.", vbExclamation Exit Sub End If selectedFiles = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm), *.xls; *.xlsx; *.xlsm", Title:="Select Excel Files", MultiSelect:=True) If Not IsArray(selectedFiles) Then Exit Sub For i = LBound(selectedFiles) To UBound(selectedFiles) Set wb = Workbooks.Open(selectedFiles(i)) For Each ws In wb.Sheets With ws.PageSetup .LeftFooter = mainFooterLeft .RightFooter = mainFooterRight .CenterFooter = mainFooterCenter End With Next ws wb.Close SaveChanges:=True Next i Application.ScreenUpdating = True 'MsgBox "تم تطبيق Footer على الملفات المختارة بنجاح!", vbInformation End Sub

[@aboumagyas2341]

النظام العالمي يرحب بكم