نجوم المشاركات

جرب المرفق نص 25 =Sum([i]*[j]) 2x.accdb

جرب هذا الملف Fathi.xlsx

انظر لهذا المرفق لعله يفى بالغرض نسخة من تلوين لون خط الخليتان اذا تحقق الشرطان.xlsx

السلام عليكم جرب المرفق لعل فيه ما تريد... بن علية حاجي تجربة __.xlsx

تفضل مخزن الأثاث.xlsm

See this file الاسم الأخير.xlsm

ربما ينال الاعجاب هذا الملف Fuction_split_name.xlsm

فرج الله همك ، ووسع لك في رقك وأسأل الله أن يبارك في عمرك وصحتك لك الشكر من الأعماق وخالص الدعاء بالضبط هذا ما أريده وأهنيك على الحلول التي لا تخطر على بال أكرر شكري وتقديري

لعل هذا ما تريد OfFICE_1.xlsx

وهذه طريقة أخرى .... الكود.accdb

اتفضل التعديل نسخة من تلوين لون خط الخليتان اذا تحقق الشرطان.xlsx

ممتاز وشغل رائع الف شكر الى ا/سليم

العفو استاذ ازهر واحنا في الخدمة

احسنت أستاذ @kha9009lid شكرا جزيلا

في i كان فيه خطاء في اسم مربع النص انت كتبت رقم غير صحيح في k كان الخطاء انك حاولت تجمع عنوان الحق وليس الحقل في x1 انت وضعته محسوب في النموذج وبالتالي يحصل خطاء عند تجميع حقل محسوب وبالتالي لتخطي المشكلة قمت بتعديل عملية الضرب في الجدول مباشرة 2.accdb

أعلنت الجمعية الامريكية لعلم النفس و المسؤولة عن اصدار نظام التوثيق العلمي الأشهر APA أن النسخة السابعة من APA Style ستصدر فى أكتوبر القادم للمزيد حول النسخة ، اضعط هنا و هذا الملف يوضح التحديثات فى النسخة الجديدة

شكرا جزيلا أستاذ @kha9009lid لكني حاولت تتطبيق على النموذج لدي لاحظ المشكلة ممكن تخبرني اين الخطاء 2.accdb

جرب المرفق عن طريق مربعات نص غير منظمة 21.accdb

استاذنا وخبيرنا / @kha9009lid والله انت اللى دكتور في الاكسس بارك الله فيك وجعله في ميزان حسناتك ورزقك الفردوس هو المطلوب بالصبط

مرحبا دكتور حلبي في حدث عند النقر لامر طباعة ضع الكود التالي On Error Resume Next DoCmd.SelectObject acReport, "اسم التقرير", True DoCmd.RunCommand acCmdPrint بخصوص الفترة للزمنية للتقرير باضافة مربعي نص غير مرتبطة في التقرير المربع الاول في مصدر البيان للمربع ضع التالي وغير ما يلزم اسم النموذج وحقل بداية التاريخ حسب الاسماء في نموذجك =[Forms]![اسم_النموذج]![start1] وفي المربع الثاني.وغير ما يلزم =[Forms]![اسم_النموذج]![end1]

كان يجب منذ البداية ارفاق الملف تم معالجة الامر SALIM_DV.xlsm

اذا كنت ترى ان المشكلة قد تم حلها اضغط افضل اجابة لاغلاق الموضوع

اللهم رب الناس اذهب البأس و اشف انت الشاف أجر و عافية باذن الله 🌹

الملحوظة الأولي : تطبيق التلوين على المعادلات ايضا و ليس النصوص فقط ربما لا يمكن عمل ذلك ، و اتمني أن يجد الأخوة حل لهذا الأمر الملحوظة الثانية : تطبيق التلوين على ما يكتب من النصوص و ليس فقط عند تعديل الخلية C1 جرب التعديل البسيط التالي لكود الأخ وجيه Private Sub Worksheet_Change(ByVal Target As Range) Dim lr As Integer If IsEmpty(Range("c1")) Then Exit Sub lr = Range("b" & Rows.Count).End(xlUp).Row Range("b4:b" & lr).Font.ColorIndex = xlAutomatic For Each c In Range("b4:b" & lr) For i = 1 To lr If Mid(c.Value, i, Len(Range("c1"))) = Range("c1").Value Then c.Characters(i, Len(Range("c1"))).Font.Color = vbRed End If Next Next End Sub

اجعل عمود التقييد هو العمود الذى تأخذ منه البانات للقائمة المنسدلة او كما اخبرتك من قبل لتجنب عدم اهدار الوقت فعليك برفع الملف موضح عليه المطلوب بكل دقة

وعليكم السلام-تفضل لك ما طلبت-نورتنا في المنتدى 1فاتورة.xlsm

السلام عليكم يمكن هذا حل آخر للمسألة... بن علية حاجي دوام.xlsx

عليكم السلام تفضل اخى الكريم تجزئة الاسم.xlsx

تم التعديل على الماكرو ليتناسب مع المطلوب كل ما عليك هو اختيار اسم الاستاذ من الكومبو 1 او اسم المادة من الكومبو 2 Option Explicit Private Sub ComboBox1_Change() get_data_Prof End Sub '++++++++++++++++++++++++++++++++ Private Sub ComboBox2_Change() get_data_Matiere End Sub '+++++++++++++++++++++++++++++++++++++ Private Sub Worksheet_Activate() fil_combo End Sub '==================================== Sub fil_combo() Dim dic As Object, dic2 Dim cel As Range Set dic = CreateObject("scripting.dictionary") Set dic2 = CreateObject("scripting.dictionary") '=========================== For Each cel In Sheets("جدول عام").Range("c66:c85") If Not dic.exists(cel.Value) And cel <> "" Then dic.Add cel.Value, "" dic2.Add cel.Offset(, -1).Value, "" End If Next '=========================== For Each cel In Sheets("جدول عام").Range("i66:i85") If Not dic.exists(cel.Value) And cel <> "" Then dic.Add cel.Value, "" dic2.Add cel.Offset(, -1).Value, "" End If Next ComboBox1.List = dic.keys ComboBox2.List = dic2.keys ComboBox1.BackColor = RGB(135, 255, 204) ComboBox2.BackColor = RGB(135, 255, 204) dic.RemoveAll: Set dic = Nothing dic2.RemoveAll: Set dic2 = Nothing End Sub '+++++++++++++++++++++++++++++++++++++++++++ Sub get_data_Prof() Dim Am As Worksheet: Set Am = Sheets("جدول عام") Dim Fr As Worksheet: Set Fr = Sheets("جدول فردي") Dim Rg_to_copy As Range Dim Start_Col%: Start_Col = 2 Dim Start_Row%: Start_Row = 9 Dim k%, x%, i% Fr.Range("B9:f12").ClearContents Fr.Range("B14:f17").ClearContents With Am .Range("c7:z14").Name = "Rg_1" .Range("c15:z22").Name = "Rg_2" .Range("c23:z30").Name = "Rg_3" .Range("c31:z38").Name = "Rg_4" .Range("c39:z46").Name = "Rg_5" End With For k = Start_Col To 6 Set Rg_to_copy = Am.Range("Rg_" & k - 1) For i = 1 To Rg_to_copy.Rows.Count On Error Resume Next x = Rg_to_copy.Rows(i).Find(Fr.Range("f6")).Column On Error GoTo 0 If x Then Cells(Start_Row, k) = Fr.Range("f6") End If Start_Row = Start_Row + 1 If Start_Row = 13 Then Start_Row = 14 x = 0 Next i Start_Row = 9 Next k End Sub '++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub get_data_Matiere() Dim Am As Worksheet: Set Am = Sheets("جدول عام") Dim Fr As Worksheet: Set Fr = Sheets("جدول فردي") Dim Rg_to_copy As Range Dim Start_Col%: Start_Col = 2 Dim Start_Row%: Start_Row = 30 Dim k%, x%, i% Fr.Range("B30:f33").ClearContents Fr.Range("B35:f38").ClearContents With Am .Range("c7:z14").Name = "Rg_1" .Range("c15:z22").Name = "Rg_2" .Range("c23:z30").Name = "Rg_3" .Range("c31:z38").Name = "Rg_4" .Range("c39:z46").Name = "Rg_5" End With For k = Start_Col To 6 Set Rg_to_copy = Am.Range("Rg_" & k - 1) For i = 1 To Rg_to_copy.Rows.Count On Error Resume Next x = Rg_to_copy.Rows(i).Find(Fr.Range("F27")).Column On Error GoTo 0 If x Then Cells(Start_Row, k) = Fr.Range("B27") End If Start_Row = Start_Row + 1 If Start_Row = 34 Then Start_Row = 35 x = 0 Next i Start_Row = 33 Next k End Sub NEW_Repport.xlsm

جرب هذا الملف التسميات ( ..... RG_1,RG_2) تجدها داخل الملف Named Range الماكرو المستعمل Sub fil_table() Dim i%, t%, k% Dim MAIN_RG As Range Set MAIN_RG = Range("B9:F16") Dim VAR_RG As Range Set VAR_RG = Range("B7:F7") Dim RG_Saech As Range Dim My_MATCH As Range Dim COL% Range("B9:F16").ClearContents For k = 1 To 5 Select Case k Case 1 Set RG_Saech = Sheets("جدول عام").Range("RG_1") Case 2 Set RG_Saech = Sheets("جدول عام").Range("RG_2") Case 3 Set RG_Saech = Sheets("جدول عام").Range("RG_3") Case 4 Set RG_Saech = Sheets("جدول عام").Range("RG_4") Case 5 Set RG_Saech = Sheets("جدول عام").Range("RG_5") End Select For i = 9 To 16 t = i - 8 Set My_MATCH = RG_Saech.Rows(t) COL = Sheets("جدول عام").Range("b6:Z6").Find(Sheets("جدول فردي").Range("F6")).Column MAIN_RG.Cells(t, k) = Intersect(My_MATCH, Sheets("جدول عام").Cells(6, COL).Resize(62)) Next Next End Sub الملف مرفق OUSTAZ.xlsm

بعد اذن استاذنا الفاضل استاذ سليم انظر الى هذا الملف لعله يفى بالغرض البحث فى اكثر من شيت.xlsm