أسامة البراوى

السلام عليكم
يمكن اتباع الخطوات التالية لفتح الملف : 
1- ممكن تفتح الملف بالضغط على زر الماوس الايمن ثم اختيار  protected view  
2- سوف يفتح الاكسل بدون عرض الفورم مع رسالة تحذير 
 
3- قم باظهار محرر الفيجيوال بيسك قبل الموافقة على التحرير  
 
4- قم بالموافقة على التحرير سوف تظهر الفورم ولكن محرر الفيجوال بيسك فى الخلفية يمكنك ايقاف التنفيذ لاخفاء الفورم والعودة الى الملف  

5- الغى هذا الاكواد حتى الانتهاء من عملك : 
Private Sub Workbook_Open() Application.Visible = False mainform.Show End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = 0 Then Cancel = True End If End Sub وومككن تشغله لما تخلص تصميم وتضيف الازرار المناسبة

السلام عليكم
المشكله انك حاطط المعادله داخل جدول
خد نسخه من المعادله فى اي مكان بعيد عن الجدول وهيا تشتغل 
 TEST.xlsm

السلام عليكم
بالنسبة للشيت المرفق اظن اللى ممكن يكون مسبب تقله هو كمية المعادلات فى الاعمدة h , i, j  و خاصة العمود j
والحل من وجهة نظري انك تلغى الاعمدة دي كلها وتستبدل المعادله فى العمود g  الى المعادلة التالية 
=CEILING((D8+B8)/100/5,1)*5 ودي بتحسب لك العائد بنسبة 1% لاقرب 5 جنية (اعلى من المحسوب مباشرة) زي مانت عايز وبدون المعادلات الزياده فى الاعمدة الاخرى
بالمناسبة فى خطأ هايحصل فى رصيد نهاية اليوم لما تشيل الاعمدة حاول تظبط معادلتها اظن انها محتاجة اعادة صياغة لانها حتى وبدون حذف اعمدة بتعطى نتائج غير منطقية

السلام عليكم
مرفق الملف بعد إضافة الاكواد التالية مع توضيح أجزاء الكود وتفعيل عمليات البحث والاضافة والحفظ
* تم اضافة زرار مؤقت باللون الاصفر لاستدعاء الفورم من الشاشة الرئيسة
برنامج مخازن user 12345.zip
 
' تعريف المتغيرات الرئيسه Dim Sheet_Name As String Dim L_Row As Integer Dim Current_Row As Integer Private Sub UserForm_Initialize() ' ملء الكمبوبوكس الأساسى حسب جدول اسماء الشيتات L_Row = ThisWorkbook.Sheets("هام جدا للبرمجة").Range("A" & Rows.Count).End(xlUp).Row Me.ComboBox1.RowSource = "='هام جدا للبرمجة'!A2:A" & L_Row End Sub Private Sub ComboBox1_Change() ' عند اختيار اسم الشيت يتم حفظةفى المتغير الرئيسي لاستعماله فيما بعد Sheet_Name = Me.ComboBox1.Value L_Row = Sheets(Sheet_Name).Range("A" & Rows.Count).End(xlUp).Row ' ربط الشيت بالليست بوكس ListBox2.Visible = True Me.ListBox2.ColumnCount = 2 Me.ListBox2.ColumnWidths = "70,120" ListBox2.RowSource = "='" & Sheet_Name & "'!A3:B" & L_Row End Sub Private Sub ListBox2_Change() ' التنقل عبر اختيارالبنود من الليست بوكس Current_Row = ListBox2.ListIndex + 3 Me.TextBox1 = Sheets(Sheet_Name).Range("A" & Current_Row) Me.TextBox2 = Sheets(Sheet_Name).Range("B" & ListBox2.ListIndex + 3) End Sub Private Sub CommandSearch_Click() ' البحث عن قيم معينة وادراجها فى الليست بوكس الخاصة بالبحث ListBox1.Clear If Len(Sheet_Name) = 0 Then MsgBox "من فضلك اختار ورقة العمل" Exit Sub End If If Len(Trim(TextBox3.Text)) = 0 Then MsgBox "لم يتم إدخال قيمة للبحث عنها" ListBox1.Visible = False Exit Sub End If Dim myArray() As String Dim iRow As Integer ListBox1.ColumnCount = 3 ListBox1.ColumnWidths = "0, 70,120" For i = 0 To ListBox2.ListCount - 1 If InStr(1, ListBox2.List(i, 1), TextBox3.Text) <> 0 Then ListBox1.AddItem ' إضافة عمود مخفى برقم البند فى الليست يوكس الاساسي لتسهيل التنقل ListBox1.List(ListBox1.ListCount - 1, 0) = i ListBox1.List(ListBox1.ListCount - 1, 1) = ListBox2.List(i, 0) ListBox1.List(ListBox1.ListCount - 1, 2) = ListBox2.List(i, 1) End If Next ListBox1.Visible = True End Sub Private Sub ListBox1_Change() 'كود التنقل بواسطة قائمة نتائج البحث If ListBox1.ListCount > 0 Then If ListBox1.ListIndex > -1 Then ListBox2.ListIndex = ListBox1.List(ListBox1.ListIndex, 0) End If End If End Sub Private Sub Command_Add_Click() ' لإضافة بند جديد يتم إضافة سطر الى مصدر الليست الاساسى ثم التنقل الى السطر الجديد If Len(Sheet_Name) = 0 Then MsgBox "من فضلك اختار ورقة العمل" Exit Sub End If L_Row = L_Row + 1 ListBox2.RowSource = "='" & Sheet_Name & "'!A3:B" & L_Row ListBox2.ListIndex = L_Row - 3 End Sub Private Sub CommandDelete_Click() ' كود الحذف If Len(Sheet_Name) = 0 Then MsgBox "من فضلك اختار ورقة العمل" Exit Sub End If If Current_Row = 0 Then MsgBox "قم باختيار القيم التى تود حذفها" Exit Sub End If Dim R R = MsgBox("هل ترغب فى حذف السطر الحالى", vbOKCancel + vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "تاكيد الحذف") If R = vbOK Then Sheets(Sheet_Name).Rows(Current_Row).Delete End If ComboBox1_Change End Sub Private Sub CommandSave_Click() ' كود الحفظ If Len(Sheet_Name) = 0 Then MsgBox "من فضلك اختار ورقة العمل" Exit Sub End If If Current_Row = 0 Then MsgBox "قم باختيار القيم التى تود تعديلها او حفظها مسبقا" Exit Sub End If If TextBox1.Text = "" Or TextBox2.Text = "" Then MsgBox "هناك خطأ فى بيانات الكود أو الاسم" Exit Sub End If 'يمكنك هنا ايضا إضافة جمل برمجيةالتأكد من عدم تكرار رقم الصنف اوالكود مسبقا If Application.WorksheetFunction.CountIf(Sheets(Sheet_Name).Range("A1:A" & L_Row), TextBox1.Text) > 0 Then If Sheets(Sheet_Name).Range("A" & Current_Row).Value = TextBox1.Text Then GoTo 1 MsgBox "الكود المدخل متكرر برجاء التأكد من عدم تكرار الاكواد", vbOK + vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "الكود موجود مسبقا" TextBox1.Text = Sheets(Sheet_Name).Range("A" & Current_Row).Value Exit Sub End If 1: Dim CodeNr Dim CodeDiscr ' يفضل حفظ البيانات بعد التحديث فى متغيرات مؤقتة لتفادى الخطأ اثناء الحفظ ثم تحديثها فى ورقة العمل CodeNr = TextBox1.Text CodeDiscr = TextBox2.Text Sheets(Sheet_Name).Range("A" & Current_Row).Value = CodeNr Sheets(Sheet_Name).Range("B" & Current_Row).Value = CodeDiscr MsgBox "تم حفظ البيانات بنجاح", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تاكيد" End Sub Private Sub CommandEnd_Click() Me.Hide UserFormMain.Show End Sub  
 

السلام عليكم
بالنسبة لعدد البيانات 100 او 1000 موظف لكل شهر ليس بكثير لجمعه في جدول واحد 
ويوجد طرق أخرى لتجميع الجداول خلاف ما تم شرحه مسبقا
وممكن حل اخر باستخدام Power Query كما في الملف التالي
Evaluation 1.xlsx
ودا مش ها تفرق معاه كمية البيانات 
وطريقة الحل مشروحة في الفيديو التالي
شرح دمج الجداول بواسطة Excel Power Query
 

السلام عليكم ..مرفق الملف بالأكواد
SEPTEMBER UPDATE TEST-o.xlsm
ملحوظة :
لو عايز المستخدم ليه صلاحيات التغيير ينستعمل الكود ده
 الفورم مرتبطه مباشرة بالخليه بمعنى ان اي تغيير اثناء عرض الفورم يتم تحديثه مباشرة
        Connect_With_Row (ComboBox1.ListIndex + 4)
        اما لو عايز له صلاحيات عرض فقط يبقى حط علامة  '  اول السطر السابق وشيلها  من السطر ده
  الفورم تعرض السطر فقط بمعنى ان اي تغيير اثناء عرض الفورم لا يتم تحديثه مباشرة يحتاج لكود اخر للتحديث
        'Show_Row (ComboBox1.ListIndex + 4)
        

السلام عليكم
المشكله  هى Do-Loop فى كود الفورم mainform
Private Sub UserForm_Activate() Me.BackColor = RGB(40, 116, 166) Me.Frame1.BackColor = RGB(40, 116, 166) Me.Label1.Caption = Date Me.Label2.Caption = Format(Date, "ddd") Do Me.Label3.Caption = Time DoEvents Loop End Sub ودي بتخللى الفورم شغال الخلفيه 
طيب ايه الحل
1- ها نعرف المتغير فى اول الفورم خالص وليكن Dim StopClock as Boolean 
2- ها نتأكد انه False فى بدايه تشغيل ال form من من حدث 
Private Sub UserForm_Initialize() StopClock = False End Sub 3- هانضيف شرط فى دائرة ال Do انها ما تعملش حاجه لو StopClock= true
Private Sub UserForm_Activate() Me.BackColor = RGB(40, 116, 166) Me.Frame1.BackColor = RGB(40, 116, 166) Me.Label1.Caption = Date Me.Label2.Caption = Format(Date, "ddd") Do If StopClock = True Then Exit Sub Me.Label3.Caption = Time DoEvents Loop End Sub هانتأكد ان قيمة المتغير True قبل ما نعمل unload للفورم 
Private Sub CommandButton6_Click() Application.Visible = True StopClock = True Unload Me End Sub لما تدوس على الزرار بعد كده هتلاقى الشيتات مفتوحه عادي والايديت عادي
جرب الملف المرفق
dwork.xlsm
 

اتفضل الحل واكتشف التعديلات
 
مشروع كامل - OB.xlsm

السلام عليكم
 تفضل النسخة المعدلة بعد تلافى الخطا السابق
واضافة زر لمسح البيانات من ورقة العمل المجمعة
 
إقرار.rar

السلام عليكم
مرفق اخر لجب البيانات (من جميع الملفات csv)  الى ملف اكسل واحد
 
وسهل الاستخدام ...
1- ممكن فى اول استخدام تشيل اى اوراق عمل (شيتات) زائدة عن الحاجة ما عدا الشيت الرئيسى
2- اختار المجلد الذى يحتوى ملفات CSV  المطلوب استدعائها
3- يقوم البرنامج باستدعاء بيانات الملفات كل واحد فى شيت منفصل
4- البيانات المتجددة من عمود A حتى J
 
5- اعمل الدوال والوظئف التى تريدها خارج هذه الاعمدة 
 
6- لتحديث البيانات هناك طريقتين
الاولى : بالضغط على المفتاح (جلب البيانات) : بيمسح اى بيانات موجودة فى الشيتات تقع فى الاعمدة A حتى J (وتستدعى اى ملفات جديدة ان وجدت) من المجلد الذى تقوم بتحديده (نغ=فس الخطوات 2 ، 3)
الثانية: تستلزم ان تكون الملفات الجديدة فى نفس المجلد القديم  ، وتقوم بعمل تحديث تلقائى للبيانات (لو فيه  اى ملفات جديدة لن تشملها )
 
Import From CSV to Excel Rev 02.rar
 
2جلب البيانات اول مرة

اتفضل
 
ترحيل الدور الثاني-OB4.rar

المعادلة تبحث عن جزء من الجملة "دور ثان" واذا وجدته ضمن محتوى الخلية بترد  برقم يعبر عن مكانه وفى الحالة دى الدالة if تعتبرها true ويتحقق الشرط طالما كان فيه هذا الجزء مهما كان طول محتوى الخلية
اما اذا لم يجد هذا الجزء فالرد برسالة خطأ تعتبر FALSE
 
وبالنسبة للاستدعاء
يجب تعديل الكود
ترحيل مفيد باختبار اعمدة معينة 2.rar