ياسر خليل أبو البراء

جرب الكود التالي لزر الأمر المسمى "حفظ الجديد" Private Sub CommandButton3_Click() Dim i As Integer, LastR As Long, ws As Worksheet Set ws = ThisWorkbook.Sheets("البيانات") LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1 With ws For i = 2 To 17 .Cells(LastRow, i).Interior.ColorIndex = 8 .Cells(LastRow, i).Value = Me.Controls("TextBox" & i).Value Next i End With MsgBox "تم حفظ بيانات الموظف بنجاح", vbOKOnly + vbInformation, "تم الحفظ" For i = 2 To 17 Me.Controls("TextBox" & i).Value = "" Next i CommandButton3.Enabled = False CommandButton4.Enabled = False Me.ComboBox1.Clear TextBox2.SetFocus End Sub

ممكن ترفق الملف الذي به المشكلة للإطلاع عليه

أخي الكريم طالما أن الملف به هذا العدد من الصفوف فالأفضل استخدام كود جرب الكود التالي عله يفي بالغرض Sub AdvancedFilter() Dim ws As Worksheet Dim sh As Worksheet Dim lastRow As Long Set ws = Sheets("ورقة1") Set sh = Sheets("ورقة2") lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row sh.Range("A4:C10000").ClearContents ws.Range("A1:C" & lastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=sh.Range("A1:C2"), CopyToRange:=sh.Range("A3:C3"), Unique:=False End Sub

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

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

جرب إضافة السطر التالي ws.Cells(T, 3).Resize(1, 10).Interior.Color = vbCyan بعد هذا السطر If Me.ComboBox1.Text = ws.Cells(T, 3) Then حيث الرقم 10 عدد الأعمدة المطلوب تلوينها بدايةً من العمود الثالث

وعليكم السلام أخي الكريم مهند عندما لا يكون هناك ردود على الموضوع فاعلم أن الموضوع يحتاج لمزيد من الشرح والتوضيح بعد الإطلاع على ملفك .. وجدت أنك تريد التعديل على الفورم بحيث يتناسب مع ورقة العمل الأولى Sheet1 ، ووجدت أن الفورم يعتمد بشكل أساسي على رقم كود في ورقة العمل Sheet2 ، ولم أجد عمود لرقم الكود في ورقة Sheet1 .. في انتظار التفسير والتوضيح

بارك الله فيك أخي الحبيب ربيع وجزيت عنا خير الجزاء يعمل بشكل جيد مع أوفيس 2016 ونسخة ويندوز 7 32 بت سؤال : هل يمكن تغيير الاتجاه بحيث يظهر من اليمين لليسار ؟

ليس لدي فكرة في الواقع .. ربما لو أرفقت ملف نقوم ببعض المحاولات بحيث يكون الملف معبر عن الملف الأصلي وما هي تلك العمليات الحسابية التي تتم في أكثر من 16 ألف عمود ..أول مرة تقابلني حالة بهذا الشكل

ليس شرط ..ممكن أن تتواجد هذه المكتبات في أجهزة وأجهزة أخرى لا تتواجد .. وربما بعد ما قمت بحذفها يعمل على أي جهاز أعتقد المشكلة تحدث عند العمل على نسخة أوفيس 2007 ثم العمل على نسخة أحدث بعد ذلك

احتمال أم تكون ملفات ناقصة في نسخة الأوفيس أو الويندوز الذي لا يعمل عليه الملف هذا والله أعلم

السلام عليكم ادخل لمحرر الأكواد Alt+F11 ادخل على القائمة Tools ثم اختر References .. ستجد بعض الخيارات التي بجوارها علامة صح مكتوب بجابنها Missing ، قم بإزالة علامة الصح لأن هذه المكتبات مفقودة ...

الحمد لله الذي بنعمته تتم الصالحات اللهم آمين ولك بمثل إن شاء العلي القدير بالنسبة للشرح حاول تتابع قناة اليوتيوب فأنا أحاول تقديم شروحات بشكل متنوع لأكواد مختلفة .. ومنها أكواد متقدمة وحاول تدرس الكود لترى الأسطر الموجودة وتحاول فهمها وإذا صعب عليك جزء فيها أخبرنا بهذا الجزء ، وستجد الرد مني أو من غيري إن شاء الله تقبل تحياتي

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

لربما لعدم الاستجابة لرفع ملف مرفق

أخي الكريم ناصر جرب الكود التالي Sub PrintClassesYK() Dim wshD As Worksheet Dim wshS As Worksheet Dim x As VbMsgBoxResult Dim b As Boolean Dim i As Long Dim lr As Long Dim c As Long Dim strClass As String Const studentData As String = "رصد الترم الثانى" Const shehada As String = "شهادة" Const strSucce As String = "*نا*" x = MsgBox("هل تريد طباعة كل الناجحين؟ إذا كانت الإجابة بنعم سيتم طباعة كل الناجحين أم لا سيقوم بطباعة الفصول", vbYesNoCancel) Select Case x Case vbYes b = True Case vbNo b = False Case vbCancel MsgBox "لم يتم تنفيذ الأمر لأنك نقرت على إلغاء يا ناصر", vbExclamation: Exit Sub End Select Application.ScreenUpdating = False Set wshD = Sheets(studentData) Set wshS = Sheets(shehada) strClass = wshS.Range("W2").Value c = 2 lr = wshD.Range("C7").End(xlDown).Row For i = 7 To lr If (b And wshD.Cells(i, 157) Like strSucce) Or (Not b And wshD.Cells(i, 4).Value = strClass) Then If c Mod 2 = 0 Then wshS.Cells(3, 13) = wshD.Cells(i, 2) wshS.Cells(12, 3) = wshD.Cells(i, 157) wshS.Cells(12, 6) = wshD.Cells(i, 158) Else wshS.Cells(19, 13) = wshD.Cells(i, 2) wshS.Cells(28, 3) = wshD.Cells(i, 157) wshS.Cells(28, 6) = wshD.Cells(i, 158) wshS.Range("A1:P31").PrintOut wshS.Cells(3, 13) = "" wshS.Cells(19, 13) = "" End If c = c + 1 End If Next i If wshS.Cells(19, 13) = "" And wshS.Cells(3, 13) <> "" Then wshS.Range("A1:P15").PrintOut End If Application.ScreenUpdating = True End Sub

سأحاول تجربة الكود مرة أخرى في أقرب وقت إن شاء الله

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

أخي ناصر لم تذكر تلك النقطة من البداية ويبدو أن الموضوع بهذا الشكل يزاداد تعقيداً ..عموماً جرب تغيير السطرين لديك اللذين فيهما الشرط إلى هذا الشكل (لم أجرب لضيق الوقت لدي) If IIf(b = True, Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*", True) And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then ستقوم بتغيير السطرين بنفس الأسلوب وجرب وأخبرني بالنتائج

الكود بهذا الشكل سليم إن شاء الله ولكن طالما أننا سنتعامل مع أكثر من ورقة عمل فلابد من الإشارة لورقة العمل التي فيها قيمة الخلية (القائمة المنسدلة) قم بالإشارة إلى ورقة العمل قبل كلمة Range في هذا السطر strClass = Sheets(StudentData).Range("W2").Value

قم بتصميم قائمة منسدلة بالفصول وجعل قيمة المتغير strClass تساوي تلك الخلية ولكن في تلك الحالة لن يكون ثابت Const بل يجب تغييره ليكون متغير بهذا الشكل Dim strClass as String strClass=Range("J6").Value باعتبار أن الخلية J6 ستحتوي على القائمة المنسدلة تقبل تحياتي

وجزيت خيراً بمثل ما دعوت لي أخي الكريم حسين والحمد لله أن نال الفيديو إعجابك وأرجو أن يكون واضح ومفيد للجميع لأننا نريد إحداث طفرة في طريقة التفكير في البرمجة لا أن تكون البرمجة قائمة على النسخ للأكواد والتعديل عليها فقط بل أتطلع إلى وجود أشخاص متعلمين يستطيعون تقديم إبداع ونريد أن ننافس المنتديات الأجنبية فيما وصلوا إليه ونستطيع على الأقل مجاراتهم

جرب الكود التالي .... Sub كل_الناجحين() Const StudentData As String = "رصد الترم الثانى" Const Shehada As String = "شهادة" lr = Sheets(StudentData).Range("C7").End(xlDown).Row c = 2 Application.ScreenUpdating = False x = MsgBox("هل تريد طباعة كل الناجحين؟ إذا كانت الإجابة بنعم سيتم طباعة كل الناجحين أم لا سيقوم بطباعة الفصول", vbYesNoCancel) If x = vbYes Then b = True ElseIf x = vbNo Then b = False strClass = InputBox("أدخل الفصل") If IsError(Application.Match(strClass, Sheets(StudentData).Columns(4), 0)) Or strClass = "" Then MsgBox "لا يوجد فصل لديك بهذا الشكل", vbExclamation: Exit Sub End If Else MsgBox "لم يتم تنفيذ الأمر لأنك نقرت على إلغاء يا ناصر", vbExclamation: Exit Sub End If For i = 7 To lr If c Mod 2 = 0 Then If Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*" And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then Sheets(Shehada).Cells(3, 13) = Sheets(StudentData).Cells(i, 2) Sheets(Shehada).Cells(12, 3) = Sheets(StudentData).Cells(i, 157) Sheets(Shehada).Cells(12, 6) = Sheets(StudentData).Cells(i, 158) c = c + 1 End If GoTo 1 Else If Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*" And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then Sheets(Shehada).Cells(19, 13) = Sheets(StudentData).Cells(i, 2) Sheets(Shehada).Cells(28, 3) = Sheets(StudentData).Cells(i, 157) Sheets(Shehada).Cells(28, 6) = Sheets(StudentData).Cells(i, 158) c = c + 1 Sheets(Shehada).Range("A1:P31").PrintOut Sheets(Shehada).Cells(3, 13) = "" Sheets(Shehada).Cells(19, 13) = "" End If End If 1: Next i If Sheets(Shehada).Cells(19, 13) = "" And Sheets(Shehada).Cells(3, 13) <> "" Then Sheets(Shehada).Range("A1:P15").PrintOut End If Application.ScreenUpdating = True End Sub

أعتقد أن الأستاذ محمد صالح قدم حل لهذه الإشكالية على ما أذكر .. ألم يفي الحل بالغرض ...؟

بارك الله فيك أخي الكريم ناصر ممكن توضيح للمطلوب بخصوص "شهادات بدل كلمه ناجح نكتب فصل ونطلع الشهادات بمعيه الفصول"