أبومروان

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

وعليكم السلام ورحمه الله وبركاته 
اكواد لتحسين الاداء 
Sub OptimizePerformance() ' إيقاف التحديثات على الشاشة Application.ScreenUpdating = False ' إيقاف الحسابات التلقائية Application.Calculation = xlCalculationManual ' إيقاف الأحداث Application.EnableEvents = False ' إيقاف التنبيهات Application.DisplayAlerts = False ' إيقاف الحفظ التلقائي Application.AutoRecover.Enabled = False ' إعادة تمكين كافة الإعدادات بعد الانتهاء Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.DisplayAlerts = True Application.AutoRecover.Enabled = True End Sub  

اتفضل الشيت بالكود المستخدم لعله يكون الطلوب وعدل عليه حسب ما تريد
Sub PrintSheetInChunks() Dim ws As Worksheet Dim LastRow As Long, LastCol As Long Dim RowStart As Long, RowEnd As Long Dim ColStart As Long, ColEnd As Long Dim PageNum As Long ' تحديد ورقة العمل الحالية Set ws = ThisWorkbook.Sheets("Sheet1") ' قم بتغيير اسم الورقة حسب الحاجة ' الحصول على آخر صف وآخر عمود في البيانات LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column ' تحديد عدد الصفوف والأعمدة لكل صفحة (25 صفًا و25 عمودًا) RowStart = 1 ColStart = 1 PageNum = 1 ' تحديد الصفوف والأعمدة للطباعة Do While RowStart <= LastRow RowEnd = RowStart + 24 ' 25 صفًا لكل صفحة (من RowStart إلى RowEnd) If RowEnd > LastRow Then RowEnd = LastRow ColEnd = ColStart + 24 ' 25 عمودًا لكل صفحة (من ColStart إلى ColEnd) If ColEnd > LastCol Then ColEnd = LastCol ' تحديد منطقة الطباعة ws.PageSetup.PrintArea = ws.Range(ws.Cells(RowStart, ColStart), ws.Cells(RowEnd, ColEnd)).Address ' إعدادات الطباعة With ws.PageSetup .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = False .PrintTitleRows = "" ' إذا أردت إضافة عناوين ثابتة في الأعلى يمكنك تعديل هذه .PrintTitleColumns = "" ' وإذا أردت إضافة أعمدة ثابتة يمكنك تعديل هذه End With ' طباعة الصفحة ws.PrintOut ' تحديث الصفوف والأعمدة للطباعة في الصفحة التالية RowStart = RowEnd + 1 If RowStart > LastRow Then Exit Do ' الخروج إذا تم الانتهاء من جميع الصفوف If ColEnd < LastCol Then ColStart = ColEnd + 1 Else ColStart = 1 End If PageNum = PageNum + 1 Loop End Sub  
مرتبات.xlsm

وعليكم السلام ورحمه الله وبركاته
ممكن تستخدم الكود التالي لعله المطلوب
Sub ColorCellsAboveYellow() Dim ws As Worksheet Dim cell As Range Dim targetColor As Long Dim i As Integer Set ws = ThisWorkbook.Sheets("Sheet1") targetColor = RGB(255, 255, 0) For Each cell In ws.UsedRange If cell.Interior.Color = targetColor Then For i = 1 To 2 If cell.Row - i > 0 Then ws.Cells(cell.Row - i, cell.Column).Interior.Color = targetColor End If Next i End If Next cell End Sub  
Book1.xlsm

اليك حل اخر بالاكواد لعله يفيد حضرتك
وممكن تعدل عليه علي حسب رغبه حضرتك 
Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim hijriDate As String ' تعيين الورقة النشطة Set ws = ThisWorkbook.Sheets("Sheet1") ' تأكد من تغيير اسم الورقة إذا كان مختلفًا ' التحقق إذا كان التغيير في النطاق X3 إلى آخر خلية تحتوي على بيانات If Not Intersect(Target, ws.Range("X3:X" & ws.Cells(ws.Rows.Count, "X").End(xlUp).Row)) Is Nothing Then ' العثور على آخر صف يحتوي على بيانات في العمود X lastRow = ws.Cells(ws.Rows.Count, "X").End(xlUp).Row ' تكرار عبر الصفوف من X3 إلى آخر صف For i = 3 To lastRow ' قراءة التاريخ الهجري من الخلية hijriDate = ws.Cells(i, "X").Value ' التحقق إذا كانت الخلية تحتوي على تاريخ If hijriDate <> "" Then ' التحقق إذا كان حرف "هـ" موجودًا بالفعل If InStr(hijriDate, "هـ") = 0 Then ' تحويل التاريخ إلى التنسيق المطلوب وإضافة حرف "هـ" ws.Cells(i, "X").Value = Format(hijriDate, "yyyy/mm/dd") & "هـ" End If End If Next i End If End Sub  
 
مثل التاريخ.xlsm

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

وعليكم السلام ورحمه الله وبركاته
راجع المرفق تم عمل المطلوب ان شاء الله
بحث.xls

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

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

السلام عليكم ورحمه الله وبركاته
اتفضل لعله المطلوب
Private Sub CheckBox1_Click() If CheckBox1 = True Then CheckBox2 = False CheckBox3 = False CheckBox4 = False [c4] = " True" [d4] = " False" [e4] = " False" [f4] = " False" Else End If End Sub Private Sub CheckBox13_Click() If CheckBox13 = True Then CheckBox1 = False CheckBox2 = False CheckBox3 = False CheckBox4 = False CheckBox5 = False CheckBox6 = False CheckBox7 = False CheckBox8 = False CheckBox9 = False CheckBox10 = False CheckBox11 = False CheckBox12 = False [c4] = " False" [c9] = " False" [c14] = " False" [d4] = " False" [d9] = " False" [d14] = " False" [e4] = " False" [e9] = " False" [e14] = " False" [f4] = " False" [f9] = " False" [f14] = " False" Else '[c4] = " " '[c9] = " " '[c14] = " " ' '[d4] = " " '[d9] = " " '[d14] = " " ' '[e4] = " " '[e9] = " " '[e14] = " " ' '[f4] = " " '[f9] = " " '[f14] = " " End If End Sub Private Sub CheckBox2_Click() If CheckBox2 = True Then CheckBox1 = False CheckBox3 = False CheckBox4 = False [c4] = " False" [d4] = " True" [e4] = " False" [f4] = " False" Else End If End Sub Private Sub CheckBox3_Click() If CheckBox3 = True Then CheckBox2 = False CheckBox1 = False CheckBox4 = False [c4] = " False" [d4] = " False" [e4] = " True" [f4] = " False" Else End If End Sub Private Sub CheckBox4_Click() If CheckBox4 = True Then CheckBox2 = False CheckBox3 = False CheckBox1 = False [c4] = " True" [d4] = " False" [e4] = " False" [f4] = " True" Else End If End Sub Private Sub CheckBox5_Click() If CheckBox5 = True Then CheckBox6 = False CheckBox7 = False CheckBox8 = False [c9] = " True" [d9] = " False" [e9] = " False" [f9] = " False" Else End If End Sub Private Sub CheckBox6_Click() If CheckBox6 = True Then CheckBox5 = False CheckBox7 = False CheckBox8 = False [d9] = " True" [c9] = " False" [e9] = " False" [f9] = " False" Else End If End Sub Private Sub CheckBox7_Click() If CheckBox7 = True Then CheckBox5 = False CheckBox6 = False CheckBox8 = False [e9] = " True" [d9] = " False" [c9] = " False" [f9] = " False" Else End If End Sub Private Sub CheckBox8_Click() If CheckBox8 = True Then CheckBox5 = False CheckBox6 = False CheckBox7 = False [c9] = " False" [d9] = " False" [e9] = " False" [f9] = " True" Else End If End Sub Private Sub CheckBox9_Click() If CheckBox9 = True Then CheckBox10 = False CheckBox11 = False CheckBox12 = False [c14] = " True" [d14] = " False" [e14] = " False" [f14] = " False" Else End If End Sub Private Sub CheckBox10_Click() If CheckBox10 = True Then CheckBox9 = False CheckBox11 = False CheckBox12 = False [d14] = " True" [c14] = " False" [e14] = " False" [f14] = " False" Else End If End Sub Private Sub CheckBox11_Click() If CheckBox11 = True Then CheckBox9 = False CheckBox10 = False CheckBox12 = False [f14] = " False" [d14] = " False" [c14] = " False" [e14] = " True" Else End If End Sub Private Sub CheckBox12_Click() If CheckBox12 = True Then CheckBox9 = False CheckBox10 = False CheckBox11 = False [c14] = " False" [d14] = " False" [e14] = " False" [f14] = " True" Else End If End Sub Checkbox1.xlsm

اتفضل ي استاذ @الفارس محمد رجب
جرب هذا الكود
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If Shift = (vbCtrlMask Or vbShiftMask) Then Unload Me End If End Sub  ودا كود تعطيل زر  جرب
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then Cancel = True MsgBox "تم تعطيل زر الإغلاق!", vbInformation, "تحذير" End If End Sub  

وعليكم السلام
اكتب اول حرف +Ctrlمع الضغط علي زرالمسافه

السلام عليكم ورحمه الله وبركاته
ايه رائيك تشوف الموضوع ادناه قد يفيدك
 
قائمة منسدلة مفلترة2.rar

بعد السلام عليكم ورحمه الله وبركاته
اتفضل لعله المطلوب

 
 
تظليل الاعمدة.xls

وعليكم السلام ورحمه الله وبركاته
يمكنك استخدام هذاه ان شاءالله يكون المطلوب وتفي الغرض اختر ما تشاء
=IFS(IF(C3-A6<0,D3*11%,(C3-A6+D3)*11/100)>1000,1000,IF(C3-A6<0,D3*11%,(C3-A6+D3)*11/100)<1000,IF(C3-A6<0,D3*11%,(C3-A6+D3)*11/100)) او =IF((C3-A6+D3)*11/100>1000, 1000, IF((C3-A6<0), D3*11%, (C3-A6+D3)*11/100)) او =MIN(MAX(IF(C3-A6<0,D3*11%,(C3-A6+D3)*11/100),0),1000) =MIN(MAX(IF(C3-A6<0,D3*11%,(C3-A6+D3)*11/100),0),1000) =IFS(IF(C3-A6<0,D3*11%,(C3-A6+D3)*11/100)>1000,1000,IF(C3-A6<0,D3*11%,(C3-A6+D3)*11/100)<1000,IF(C3-A6<0,D3*11%,(C3-A6+D3)*11/100))  

السلام عليكم
راجع الموضوع ادناه لعله يفيد
 

السلام عليكم
حالات تثبيت القيم عند سحب المعادلات
عندما تكون علامة الدولار في يسار الحرف مثل   A$ معناها الخلية مثبتة أفقيا ، اي عند السحب الأفقي لا تتغير القيمة المدخلة في الخلية
عندما تكون علامة الدولار في يمين الحرف مثل  $A  معناها الخلية مثبتة رأسيا، اي عند السحب الرأسي لا تتغير القيمة المدخلة في الخلية
عندما تكون علامة الدولار في يسار و يمين الحرف مثل  $A$  معناها الخلية مثبتة أفقيا و عموديا ، اي عند السحب الأفقي و العمودي  لا تتغير القيمة المدخلة في الخلية

استاذ @حسنى سامى محمد اعذرني لجهلي بمفهوم عمل دالهFORECAST  في المشاركه السابقه
ان شاء الله تكون هذه معادله صحيحه
تقبل تحياتي.
 
 
=FORECAST(AL$3,$B5:$AK5,$B$3:$AK$3)
TEST.xlsx

وعليكم السلام ورحمه الله وبركاته يمكنك استخدام هذه المعادله
=TEXT(A8,"dddd")
استخراج اسم اليوم.xls

استاذي الضافل @ابو صقر اقترح عليك بعض الدروس قد تفيد وتفح لك الباب اقرا بعض الموضوعات المنتدي وافتح الملفات وحاول تفهم المقصد الشروحات وفهم الاكواد
التعليم ياتي واحده واحده
 
 

السلام عليكم ورحمه الله وبركاته
جرب الكود التالي 
  Me.Textbox4 = Val(Textbox1) / Val(Textbox3) / Val(Textbox2) * Val(ComboBox3) * Val(ComboBox1) * Val(ComboBox2)  

السلام عليكم ورحمه الله وبركاته
جرب الاتي
1. اذهب الى Start ثم Settings
2 . اختر Control Panel
3. Regional And Language Options
4. من تبويب Advanced في خانة الاختيار اختر اللغة العربية
5. ثم OK




 
إذا كانت المشكلة اللغه في محرر الاكواد
من  مجرر الأكواد
Tools
Options
Editor Format
و اختار اي خط عربي

شاهد هذا موضوع أدناه ⬇️ رائع جدا وان شاء الله يفيدك 
 

اسمح لي استاذ @Mohamed Hicham بالمشاركة مع حضرتك 
Sub SSheet() Dim ws As Worksheet, Data As Worksheet, ShName As String Dim LR As Long, ER As Long, x As Integer Set Data = Sheets("المدخلات") ShName = Data.Range("C2").Text ER = Data.Range("B" & LR).End(xlUp).Row If Not IsEmpty(Data.Range("B10:B20")) Then For x = 10 To ER If Data.Range("B" & x).Value = ShName Then Set ws = Sheets(Data.Range("C" & x).Value) '...rest of code End If Next x End If End Sub