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

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

السلام عليكم بالنسبه للحل باستخدام Power Query الذى قمت بتطبيقه فى المشاركة 3 هو صحيح ولكن البيانات الاصليه المدخله فى الجداول هى سبب المشكله مثلا Mohammed NOOR له SR و PF مختلف كل شهر فيمجرد ان تزيل هذه الاعمده من الجدول المحوري وتكتفى بالاسم سوف يعطى نتائج افضل وهناك حل اخر ان يكون محتوى العمود SR ثابت بالنسيه لكل موظف ويكون هو الرقم الوظيفى له ومتطابق فى جميع الشهور

السلام عليكم الحل فى Pivot Table لما تقف على الجدول هتلاقى حقل PF قى القائمة اسحبه فوق الاسم مع الصفوف هتلاقيه ظهر لكن ف سطر لوحده فوق الاسم وعلشان يظهر بجواره اختار إعدادات Pivot table ثم اختار المظهر Classic ها يظهرو ف نفس السطر ولكن فى سطر إجمالى تحته قم بأخفاءه بالضغط على الزر الايمن Hide الاجمالى والغاء علامة الصح بجواره

السلام عليكم مرفق حل بالمعادلات فقط (شرط ان لا تتكرر اسماء الدول فى السطر رقم 2) قوائم منسدلة ديناميكية.xlsx

السلام عليكم اظن الأمر لا يحتاج الى كود للترحيل وممكن استعمال دالة Indirect مع دالة بسيطة لتعريف الصفحات معتمدة على الخلية F2 كما هي مكتوبة في الخانات F5 الى F14 كما في شيت "كشف الطباعة" بالملف المرفق وممكن تسهل على نفسك الأمور أكتر وتطبع الجدول بعد ما تضيف Page Header و Page Footer وتتحكم بارتفاع الاسطر لتحديد عدد الأسماء في كل صفحة كما بالشيت "كشف الطباعة 2" بنفس الملف , ترحيل الاسماء.xlsm

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

السلام عليكم: يمكن استخداد الدوال Filter و Sort بالخطوات التالية 1- للتسهيل منسدله فى خلية بأسماء المناديب ولتكن I4 2- مسح محتويات جدول بطاقة المندوب بالكامل من اول سطر 6 بما فيها العمود A 3- نكتب المعادله التالية فى الخانه A6 =SORT(FILTER('بيانات العميل'!A2:G1500,'بيانات العميل'!H2:H1500=I$4,""),2,1) =SORT(FILTER('بيانات العميل'!A2:G1500,'بيانات العميل'!H2:H1500=I$4,""),2,1) دي معادله من دالتين : الداله الاولى filter : ودي بتختار فيه جدول المصدر كله 'بيانات العميل'!A2:G1500 ثم الشرط وهو ان القيمه فى عمود المندوب = الاسم اللى احنا محددينه 'بيانات العميل'!H2:H1500=I$4 ثم القيمة المفترضه فى حالة عدم العثور على بيانات "" الدالة الثانية "Sort" ودي بتستدعى جدول (هنا اخدناه من الداله السابقة Filter) ثم ترتبه بواسطة العمود رقم 2 و بيكون الترتيب تصاعدي 1 سرد العملاء التابعين لكل مندوب 2021.xlsm ملحوظة: الدوال دى غير موجوده فى اصدارات ما قبل 2021

السلام عليكم اولا: يبدو انك نقلت المعادله من ملف به جدول بدون مسميات اعمده . لذلك هو قام بتسمية العمود الاول بهذا الأسم يمكنك تغيير هذا الرمز الى اسم الخلية المرتبطه بالمعادله (رقم الغرفة مثلا) او تحويل نطاق الخلايا الى جدول (Insert > Table) * وتأكد ان اسم النطاق اللى بيبحث فيه صح لانى مش شايف فى الجدول شيت بأسم توزيعات

السلام عليكم أظن ممكن يكون في حل بسيط للموضوع لكن فى اوفيس 2021 او 365 باستعمال دالتى Sort و Filter وبدون استخدام المصفوفات لو عندك احد الاصدارات دي هاوضحه بالتفصيل

السلام عليكم لتبسيط الامور ممكن عمل التالى: 1- تعريف الجداول فى كل شهر Insert Table ........ تكون Table1 , Table2 .... الخ 2 - تجميع الجداول اسفل بعضها فى ورقة عمل جديدة بواسطة الأسم : بمعنى ادخل الخلية A1 واكتب فيها =Table1 و كذلك فى الخلية ِA17 نكتب =Table 2 وهكذا ... الى ان تظهر نسخه من جميع الجداول تحت بعضها ( ملاحظة لازم نترك مسافة بين بداية كل جدول والاخر تساوى الحد الأقصى لصفوف الجداول فى اى شهر انا افترضتها هنا 16 سطر .. علشان لو زودنا سطر فى اي جدول ما يظهرش خطأ ) بكدا يقى عندنا عمود فيه الاسماء ممكن نستعمل دالة CountIf امام كل أسم علشان نعرف تم تقييمه فى كام شهر ونعمل SumIf بدلالة نفس العمود وطبقا للاسم ونقسم المجموع على عدد التقييمات وكده نحصل على متوسط التقييمات لكل فرد فى الاشهر اللى اتقيم فيها ... والملف مرفق Evaluation.xlsx

السلام عليكم مرفق الملف بعد إضافة الاكواد التالية مع توضيح أجزاء الكود وتفعيل عمليات البحث والاضافة والحفظ * تم اضافة زرار مؤقت باللون الاصفر لاستدعاء الفورم من الشاشة الرئيسة برنامج مخازن 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

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

السلام عليكم قبل البدء انت محتاج تغير ال listbox اللى قدام الكود الى combobox وليكن combobox2 اولا انت محتاج تملا الكمبو بوكس مع بداية عمل الفورم Private Sub UserForm_Initialize() Dim LR As Long With Sheets("update 2022 September") LR = .Range("A" & .Rows.Count).End(xlUp).Row Me.ComboBox2.RowSource = "=$A$4:$A$" & LR Me.ComboBox1.RowSource = "=$C$4:$C$" & LR End With End Sub كده انت ملأت الاتنين الكمبوبوكس يبقى انت محتاج كود عند تغيير الكمبوبوكس Private Sub ComboBox2_Change() ComboBox1.ListIndex = ComboBox2.ListIndex If ComboBox2.ListIndex <> -1 Then TextBox3.ControlSource = "=$H$" & ComboBox2.ListIndex + 4 Else TextBox3.ControlSource = "" TextBox3.Text = "" End If End Sub وبكده التكست بوكس اصبحت مرتبطه بالخليه يعنى اي تغيير فيها ها يتحدث اتوماتيتك فى الخليه * الجمله الشرطية للتأكد انك كتبت كود موجود داخل الليست , , والا يلغى ارتباط التكست بوكس بالخلية ثم يمسح محتوى التكست بوكس * ال 4 دي بداية اول سطر بيانات فى الجدول

ارفق ملف يه جزء من البيانات الاصليه ونموذج للبيانات المفلتره وحدد الاعمدة التى تود اعادتها ومن الافضل ان يوجد لكل سطر فى الملف الاصلى عمود به مسلسل او كود غير قابل للتكرار

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

السلام عليكم لحل المشكله يجب ان تتأكد اولا من تنزيل Access Database Engine من الموقع الرسمي https://www.microsoft.com/en-us/download/details.aspx?id=13255 وده ممكن تنزل الاصدار 32 او 64 حسب رغبتك تانى حل انك تعدل ال compiler> Target CBU الى x86 من قائمة خصائص المشروع

السلام عليكم رجاء ارفاق جزء من الكود للمراجعه وبالنسبه لموضوع الملف المفتوح يجب اضافه امر لاغلاق الاكسيل بعد انتهاء العمل مرفق جزء من كود يوضح التعامل مع الاكسيل عسى ان يكون مفيدا Private Sub ExportToExcel_Click() On Error Resume Next 'GoTo errhand Dim appXL As New Excel.Application Dim wbk As Excel.Workbook Set wbk = appXL.Workbooks.Add(Template:=App.Path & "\Templates\MyTemplate") DatPayments.Recordset.MoveFirst SSPanel1.Visible = True ProgressBar1.Value = 0 With wbk.Sheets(1) .Cells(3, 3).FormulaR1C1 = ": " & Me.VP_SelectProject.Text ' .DatPayments.Recordset!ProjectCode.Value .Cells(4, 3).FormulaR1C1 = ": " & Me.VPprojectName.Caption .Cells(6, 3).FormulaR1C1 = ": " & Me.VvenName .Cells(7, 3).FormulaR1C1 = Me.lblConValue.Caption With .Range("A" & 9 + 1 & ":m" & 9 + i - 1) .Borders(xlEdgeLeft).LineStyle = xlDouble .Borders(xlEdgeTop).LineStyle = xlDouble .Borders(xlEdgeBottom).LineStyle = xlDouble .Borders(xlEdgeRight).LineStyle = xlDouble .Borders(xlInsideVertical).Weight = xlThin .Borders(xlInsideVertical).LineStyle = xlContinuous .Borders(xlInsideHorizontal).Weight = xlThin .Borders(xlInsideHorizontal).LineStyle = xlContinuous End With End With wbk.Name = "aaa" 'Close objects and component and free memory. wbk.Save wbk.Close appXL.Quit Set appXL = Nothing Exit Sub End Sub

اسم الشيت لا يمكن ان يتعدي 31 حرف حسب ميكروسوفت

السلام عليكم جرب الملف المرفق . باضافة كمبو بوكس للعمود C بالاختيار يقوم بملء الكمبو بوكي الاخر بناءا على اختيارك ..ثم يقوم بالحساب بناء على الاختيار ComboBox.xlsm

نفس الحل السابق مع اضافة الكود التالى لكل النماذج حتى يتم الاغلاق من الازرار فقط مع ظهور رسالة تنبيه Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then Cancel = True MsgBox "ãä ÝÖáß Þã ÈÇÛáÇÞ ÇáäãæÐÌ ãä ÒÑ ÇáÇÛáÇÞ ÇáãÎÕÕ áÐáß", vbOKOnly End If End Sub غير كده كان فيه مشكله في امر الاغلاق للنموذج الرئيسي كلمة else كانت ناقصه حرف

اظن المشكلة الأخيرة دي كانت بسبب خطأ فى كود الاغلاق وربما لذلك لا يغلق الاكسل ويبقى عالقا فى الخلفية وطبعا بما انه مختفى قد لا يمكنك اغلاقه الا اذا فتحت ملف جديد المرفق التالي تم معالجه ما يتعلق بأوامر الاغلاق وجربته عندي يعمل جيدا dwork.xlsm

طيب جرب تجاهل الحل السابق بالكامل وجرب تضيف السطر ده فقط فى دايرة Do Loop على الملف الاصلى دون اي اكود أخرى If Application.Visible = True Then Exit Sub 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 Application.Visible = True Then Exit Sub Me.Label3.Caption = Time DoEvents Loop End Sub

جرب تضيف الاكواد على اصل الملف عندك انا كاتبها بالتفصيل ...ان شاء الله تشتغل كويس

السلام عليكم المشكله هى 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

السلام عليكم ...........ممكن تضيف السطر ده فى حدث الدبل كليك للتكست بوكس 6 و 11 و 16 و UserFor_cm.Tag = "Tex6" حسب انت باعت استعاء للفورم من اي تكست بوكس Private Sub Tex6_DblClick(ByVal Cancel As MSForms.ReturnBoolean) UserFor_cm.Tag = "Tex6" UserFor_cm.Show End Sub Private Sub Tex11_DblClick(ByVal Cancel As MSForms.ReturnBoolean) UserFor_cm.Tag = "Tex11" UserFor_cm.Show End Sub كدة سجلنا الرسالة جاية منين ونرجع الناتج للتكست بوكس مصدر الرسالة بتعديل السطر ده فى زر اضافة UserForm2.Controls(UserFor_cm.Tag) = UserFor_cm.TextBox1.Value Private Sub Button1_Click() Application.ScreenUpdating = False With CM_ListFind CM_TextFind.Text = .List(.ListIndex, 1) End With UserForm2.Controls(UserFor_cm.Tag) = UserFor_cm.TextBox1.Value Application.ScreenUpdating = True End Sub وبكدة ترجع النتيجة الى المكان اللى انت باعت منه استدعاء الفورم