hegazee

تأكد من إعدادت اللغة للجهاز و أن اللغة العربية ممكنة
افتح خيارات الاكسيل و تأكد منها

تفضل ملف محدث به كل ما طلبت 
أما بخصوص تعلم الأكواد فالموضوع بسيط و لكن يلزمه شغف التعلم مع المحاولة و الخطأ
أجازات 3.xlsm

تفضل الملف جاهز
طرح الأيام 
=DATEDIF(R16;O16;"MD") طرح الشهور
=DATEDIF(R16;O16;"YM") طرح السنوات
=DATEDIF(R16;O16;"Y") لجمع السنوات
=DATE(YEAR(O28) + T28; MONTH(O28) + S28; DAY(O28) + R28)  
جمع (2).xlsx

ممكن يكون من إعدادت اللغة
فتح:
لوحة التحكم > المنطقة (Region) > الإدارة (Administrative)
اضغط:
تغيير الإعدادات المحلية للنظام (Change system locale...)
اختر:
العربية (Egypt) أو العربية (Saudi Arabia) حسب منطقتك.
أعد تشغيل الجهاز.

جرب هذا الكود
Sub Hyperlink_cut() Dim selectedFile As String Dim result As Variant ' فتح مربع حوار لاختيار الملف With Application.FileDialog(msoFileDialogFilePicker) .Title = "اختر ملف Excel المراد قطع الرابط معه" .Filters.Clear .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsb; *.xlsm" .AllowMultiSelect = False If .Show = -1 Then selectedFile = .SelectedItems(1) Else MsgBox "لم يتم اختيار ملف.", vbExclamation Exit Sub End If End With ' محاولة قطع الرابط On Error Resume Next ActiveWorkbook.BreakLink Name:=selectedFile, Type:=xlExcelLinks If Err.Number <> 0 Then MsgBox "تعذر قطع الرابط. تأكد أن الملف مرتبط فعلاً.", vbCritical Exit Sub End If On Error GoTo 0 ' تحديد خلية H9 Range("H9").Select ' تحديد الشكل "Rectangle 4" On Error Resume Next ActiveSheet.Shapes.Range(Array("Rectangle 4")).Select On Error GoTo 0 ' الانتقال إلى المرجع "Macro1" On Error Resume Next Application.Goto Reference:="Macro1" On Error GoTo 0 End Sub  

تفضل أخي الكريم  3 ملفات
الأول إذا كان الأوفيس عندك 365  أو 2016 فيما فوق
الثاني إذا كان الأوفيس إصدار أقل من 2016
الثالث باستخدام الأكواد
لا تنسى اختيار "اختر تمت الاجابة"  إذا تم حل المشكلة
استخراج_فواتير_بدون_تكرار (365).xlsx استخراج_فواتير_بدون_تكرار (أوفيس قديم).xlsx
استخراج_فواتير_بدون_تكرار (كود).xlsm

تفضل
Sub FormatUniqueCellsInRow() Dim ws As Worksheet Dim lastRow As Long, startRow As Long Dim r As Long, i As Long, j As Long Dim values(1 To 7) As Variant Dim count As Long Dim data As Variant On Error GoTo ErrorHandler Set ws = ThisWorkbook.Sheets("Sheet1") ' تأكد من تغيير "Sheet1" إلى اسم الورقة الفعلي startRow = 3 ' الصف الذي تبدأ منه البيانات lastRow = ws.Range("C3:I" & ws.Rows.Count).Find(What:="*", _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row ' تنظيف التنسيقات السابقة من الأعمدة C:I و O With ws.Range("C" & startRow & ":I" & lastRow & ",O" & startRow & ":O" & lastRow) .Interior.ColorIndex = xlNone .Font.ColorIndex = xlAutomatic .Font.Bold = False End With ' تحميل النطاق إلى مصفوفة data = ws.Range("C" & startRow & ":I" & lastRow).Value ' المرور على كل صف For r = 1 To lastRow - startRow + 1 ' تخزين قيم الصف الحالي For i = 1 To 7 values(i) = data(r, i) Next i ' فحص القيم الفريدة For i = 1 To 7 count = 0 If Not IsEmpty(values(i)) Then For j = 1 To 7 If CStr(values(j)) = CStr(values(i)) Then count = count + 1 End If Next j ' إذا كانت القيمة فريدة If count = 1 Then ' تطبيق التنسيق على الخلية في C:I With ws.Cells(r + startRow - 1, i + 2) .Interior.Color = RGB(255, 255, 0) ' تعبئة صفراء .Font.Color = RGB(255, 0, 0) ' خط أحمر .Font.Bold = True ' خط عريض End With ' تطبيق نفس التنسيق على الخلية في العمود O في نفس الصف With ws.Cells(r + startRow - 1, "O") .Interior.Color = RGB(255, 255, 0) ' تعبئة صفراء .Font.Color = RGB(255, 0, 0) ' خط أحمر .Font.Bold = True ' خط عريض End With End If End If Next i Next r MsgBox "تمت معالجة البيانات بنجاح!", vbInformation Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical End Sub  

تفضل الملف . حطيت بعض المعلومات العشوائية لاختبار المعادلة
شهر 12022(2).xlsx

تفضل أخي ملفين
الملف الأول: يقوم بطباعة أوراق العمل حسب ما تكتبه من نطاقات في كل رسالة تظهر
الملف الثاني : ما عليك إلا كتابة نطاق طباعة كل صفحة في الخلية A1 و البرنامج يقوم بطباعتها
ملاحظات:
·  إذا اختار المستخدم الطباعة، تطبع جميع الأوراق في دفعة واحدة.
·  إذا اختار حفظ PDF، تنسخ هذه الأوراق إلى مصنف مؤقت ثم يصدر إلى PDF.
*عند التصدير بصيغة PDF اختر مجلد لحفظ ملف الطباعة فيه
*أهم شيء تنسيق الصفحات و الهوامش حيث لاحظت أن بعض الصفحات تتم طباعتها على ورقتين لعدم ضبط المسافات و الحدود
أيضا عند تغيير أسماء أوراق العمل في الملف الأول لابد أن تغيرها في الكود.
 
طباعة اكثر من صفحة.xlsb طباعة اكثر من صفحة من خلال خلية.xlsb

و أنتم بخير . جرب الكود التالي في الملف الأول
Sub Button1_Click() Dim Wb1 As Workbook, Wb2 As Workbook, FilePath As String, OnRng As Range Dim WSdata As Worksheet, WSdest As Worksheet, WSname As String: WSname = "ملف 1" Application.ScreenUpdating = False Application.Calculation = xlCalculationManual With Application.FileDialog(msoFileDialogFilePicker) .Title = "اختر ملف Excel كمصدر للبيانات" .Filters.Clear: .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsb" If .Show <> -1 Then MsgBox "لم يتم اختيار أي ملف", vbExclamation: Exit Sub FilePath = .SelectedItems(1) End With Set Wb1 = Workbooks.Open(FilePath) Set Wb2 = ThisWorkbook On Error Resume Next Set WSdata = Wb1.Sheets(WSname) Set WSdest = Wb2.Sheets(WSname) On Error GoTo 0 If WSdata Is Nothing Or WSdest Is Nothing Then MsgBox "لم يتم العثور على ورقة العمل", vbCritical Wb1.Close False Exit Sub End If ' تحديد النطاق من F9 إلى S609 Set OnRng = WSdata.Range("F9:S609") WSdest.Cells.UnMerge WSdest.Range("F9:S609").ClearContents ' مسح النطاق المحدد فقط OnRng.Copy With WSdest.Range("F9") .PasteSpecial xlPasteFormulas .PasteSpecial xlPasteFormats End With Application.CutCopyMode = False Application.Goto WSdest.Range("F9"), True Wb1.Close False Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True MsgBox "تم نسخ البيانات بنجاح", vbInformation End Sub  

و عليكم السلام
الكود التالي يحقق المطلوب فقط تأكد من أن الملفين في نفس المسار
 
Sub Button1_Click() Dim Wb1 As Workbook, Wb2 As Workbook, FilePath As String, OnRng As Range Dim WSdata As Worksheet, WSdest As Worksheet, WSname As String WSname = "إدخال بيانات أساسية" ' تأكد من أن الاسم مطابق تمامًا On Error GoTo ErrorHandler Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ' تحديد مسار الملف FilePath = ThisWorkbook.Path & "\Book2.xlsb" ' تأكد من امتداد الملف ' التحقق من وجود الملف If Dir(FilePath) = "" Then MsgBox "ملف Book2 غير موجود في المسار: " & vbCrLf & FilePath, vbExclamation Exit Sub End If ' فتح الملف بكلمة المرور Set Wb1 = Workbooks.Open(FilePath, Password:="123") ' تأكد من كلمة المرور Set Wb2 = ThisWorkbook ' التحقق من وجود ورقة العمل Set WSdata = Wb1.Sheets(WSname) Set WSdest = Wb2.Sheets(WSname) If WSdata Is Nothing Or WSdest Is Nothing Then MsgBox "ورقة العمل '" & WSname & "' غير موجودة في أحد الملفين", vbCritical Wb1.Close False Exit Sub End If ' نسخ البيانات Set OnRng = WSdata.UsedRange If OnRng.Cells.CountLarge = 1 And IsEmpty(OnRng.Value) Then MsgBox "لا توجد بيانات في الورقة المصدر", vbExclamation Wb1.Close False Exit Sub End If WSdest.Cells.UnMerge WSdest.Cells.ClearContents OnRng.Copy With WSdest.Range("A1") .PasteSpecial xlPasteFormulas .PasteSpecial xlPasteFormats End With Application.CutCopyMode = False Wb1.Close False MsgBox "تم نسخ البيانات بنجاح", vbInformation ExitHandler: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical Resume ExitHandler End Sub  

نعم، برنامج  الأوفيس ومن ضمنه Excel متوفر بنسختين:
  إصدار 32bit  و إصدار 64bit

الملف المرسل في مشاركة سابقة ممتاز و يعمل بكفاءة و يوزع عدد 2 ملاحظين في كل لجنة برجاء تجربتة و كتابة ملاحظاتك. قمت بتعديل عدد اللجان و الملاحظين ليتوافق مع اللجان عندك
توزيع الملاحظين .xlsm

إليك أخي الملف كما طلبت مع تلوين الخلايا حسب الاختيار
 
تسجيل بيانات2.xlsm

عندي ملف من إعداد الاستاذ مصطفى شرف و قمت بالتعديل عليه
الشرح للأستاذ مصطفى من هنا
 
 
توزيع الملاحظين 2024.xlsm

جرب الملف التالي حسب فهمي للموضوع
جدول 2.xlsx

جرب المعادلة التالية
=IF($B10="","",ROUND(VLOOKUP($B10,nageh,25,0), 0)) لا تنسى تحويل الفواصل حسب إصدار الأوفيس عندك

تفضل أخي الفاضل ملفين أحدهما معادلات و الآخر أكواد. اختر ما يحلو لك.
 
ناجح-راسب.xlsm ناجح-راسب.xlsx

و عليكم السلام ورحمة الله و بركاته
نعم، يمكنك طباعة الـ UserForm  في Excel باستخدام  VBA، ولكن يجب أولاً تحويل اليوزر فورم إلى صورة (Bitmap) ثم إرسالها إلى ورقة عمل أو كائن للطباعة. للأسف، الـ VBA لا يدعم طباعة اليوزر فورم مباشرة مثل ورقة العمل. يفضل ارفاق ملف لتوضيح المطلوب.
وبعد البحث في منتديات أوفيسنا وجدت الحل و قمت بالتعديل في الكود
رابط الملف الأصلي
https://www.officena.net/ib/topic/103266-معاينة-الطباعة-على-اليوزر-فورم/#google_vignette
و إليك الملف بعد التعديل
 
preview on userform.xlsm

و عليكم السلام ورحمة الله و بركاته
تفضل
نقل البيانات من عمود لاخر(2).xlsx

الله يحيك
تفضل ملفين الأول بالمعادلات و الثاني بالكود
مجموع المدة كاوقات.xlsx مجموع المدة كاوقات.xlsm

و عليكم السلام ورحمة الله و بركاته
تفضل الملف
تجربة ايجارات (2).xlsx

السلام عليكم ورحمة الله و بركاته
ظهور الفاصلة  قبل الرقم مثل '٢/٢ في شريط المعادلة في Excel له دلالة محددة لأن الفاصلة المفردة تستخدم في اكسيل لإجبار الخلية على اعتبار ما بداخلها كنص اكسيل وليس كرقم أو معادلة.
في حالتك:
عند إدخال ٢/٢ في خلية اكسيل مباشرة فقد يفسره Excel كتاريخ (مثلاً 2 فبراير)، أو ككسر.
لإجبار اكسيل على عدم تفسيره وتحويله إلى شيء آخر (تاريخ أو كسر)، يمكن إدخال '٢/٢، فيقوم اكسيل بعرض فقط ٢/٢ في الخلية لكن يظهر '٢/٢ في شريط المعادلة لتوضيح أن هذه القيمة تم إدخالها كنص صريح.   ولا تظهر في الطباعة و لا تؤثر في شيء لأنها نص
هام:
إذا رأيت '٢/٢ في شريط المعادلة:
فهذا يعني أن الخلية تحتوي على نص مكتوب يدويًا وليس تاريخًا أو رقمًا أو كسرًا. الفاصلة ' لا تظهر في الخلية، فقط في شريط المعادلة. إذا كتبت 2/2 بدون '، Excel قد يفسرها كـ تاريخ 2 فبراير  إذا كانت الخلية بتنسيق التاريخ
أو كـ الكسر 1  إذا غيرت التنسيق إلى  كسر لذلك تحديد نوع التنسيق مهم لتفسير اكسيل الصحيح.

رائع كود الاستاذ/ عبدالله
حل آخر بالمعادلات و التنسيق الشرطي بعيدا عن الأكواد
 
Book5.xlsx

تفضل
كود إخفاء (2).xlsm