الجموعي

أستاذي القدير بارك الله فيك أنا جربت هذا الكود من قبل لكن مشكل في الترقيم أنا أريده يبدأ من الصف الثالث والترقيم يبدا برقم 1 مش 3

ياريت شرح لهذه الجزئية من الكود الرئيسي عسى تفيدني في التعديل على الكود الرئيسي For i = 1 To 1 For T = 1 To Lastrow

بارك الله فيك استاذي الفاضل جزاك الله كل الخير تم العملية بنجاح أستاذي الكريم قمت بإزاحة الجدول في الشيت صفين كما في الصورة ياريت تعديل على كود الحذف If TextBox5.Text = "" Then MsgBox "قم اولا باختيار موظف لتعديله او حذفه", vbExclamation, "حذف" Exit Sub End If Lastrow = ورقة1.Cells(Rows.Count, "A").End(xlUp).Row + 1 Dim Q Q = MsgBox(" أنت على وشك حذف الاسم " & " ( " & TextBox2.Text & " ) " & " من السجل ، هل تريد المواصلة ", vbCritical + vbYesNo, "تأكيد الحذف") If Q = vbYes Then For i = 1 To 1 For T = 1 To Lastrow If TextBox5.Text = ورقة1.Cells(T, 1) Then With ورقة1 .Cells(T, i).Value = "" '.Rows(T).delete Shift:=xlUp .Range(Cells(T, 1), Cells(T, 4)).delete Shift:=xlUp Call delete End With End If Next Next MsgBox " لقد تم حذف الموظف من قاعدة البيانات ", vbInformation, "إنهاء الحذف" End If للعلم كود Call delete Sub delete() Lastrow = Cells(Rows.Count, "A").End(xlUp).Row For V = 1 To Lastrow - 1 Cells(V + 1, 1) = V Next End Sub

شكرا أستاذي على الرد ظننت ان الامر سهل معذرة مني استاذي تم إرفاق الملف

الكود يعمل جيد لكن أريد تعديل بسيط على الحذف إفتراضي الكود عند الحذف يحذف الضف بأكمله أنا أريد تقييد عند الحذف من العمود A إلى العمود F If TextBox5.Text = "" Then MsgBox "قم اولا باختيار موظف لتعديله او حذفه", vbExclamation, "حذف" Exit Sub End If Lastrow = ورقة1.Cells(Rows.Count, "A").End(xlUp).Row + 1 Dim Q Q = MsgBox(" أنت على وشك حذف الاسم " & " ( " & TextBox2.Text & " ) " & " من السجل ، هل تريد المواصلة ", vbCritical + vbYesNo, "تأكيد الحذف") If Q = vbYes Then For i = 1 To 1 For T = 1 To Lastrow If TextBox5.Text = ورقة1.Cells(T, 1) Then With ورقة1 .Cells(T, i).Value = "" .Rows(T).delete Shift:=xlUp Call delete End With End If Next Next MsgBox " لقد تم حذف الموظف من قاعدة البيانات ", vbInformation, "إنهاء الحذف" End If تعديل على زر حذف.rar

بارك الله فيكما استاذاي الفاضلان حفظكما الله

شكرا وبارك الله فيك استاذي جزاك الله خيرا إستفدت كثيرا من بحر علمك أستاذي لماذا قمت بحذف المتغير gpa Dim gpa As String هل من طريقى لتنفيذ الكود بالمتغيرين

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

أستاذي القدير شكرا على التعديل لكن عند التنفيذ ظهرت هذه الرسالة --------------------------- Microsoft Visual Basic --------------------------- Compile error: Select Case without End Select --------------------------- موافق تعليمات --------------------------- قمت بإضافة End Select قبل End sub إشتغل الفورم لكن عند إدخال العلامة في TextBox1والضغط على زر Cmd _mark1 تظهر نافذة إدخال العلامة وعند إدخال أي علامة تظهر رسالة توبيخ فقط ملف مرفق MARK1.rar

مساعدة في تصحيح أخطاء هذا الكود عند النفيذ تظهر رسالة الخطا التالية --------------------------- Microsoft Visual Basic --------------------------- Compile error: Syntax error --------------------------- موافق تعليمات --------------------------- Private Sub cmd_mark1_Click() Dim mark As Integer Dim gpa As String Me.TextBox1.Text = InputBox("أدخل العلامةأولا") mark = Val(TextBox1.Text) Select Case mark Case Is 18 To 15 MsgBox ("ممتاز") Case Is 15 To 12 MsgBox ("جيد جدا") Case Is 12 To 10 MsgBox ("جيد") Case Is 10 To 7 MsgBox ("متوسط") Case Is 7 To 0 MsgBox ("ضعيف") Case Else MsgBox ("توبيخ") NextEnd Sub

بارك الله فيك أستاذي/حسام عيسى شرح ممتاز جزاك الله كل الخير إحترامي وتقديري

تفضل أخي هذه المحاوله وعسى تفيدك تم تحويل بالماكرو علما أني لست بخير في تحويل المعادلات إلى كود تحويل معادلة جمع الى كود.rar

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

ألف ألف مبروك أستاذي/حسام عيسى على هذه الترقية فعلا تستحقها على جداره مزيد من التألق

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

أستاذي/ضاحي الغريب شاكر مرورك العطر وإثرائك للموضوع فعلا إضافه رائعة جدا جعلها الله في موازين حسناتك بارك الله فيك وفي مساعيك تقبل ودي وتقديري

تفضل أخي كود إنشاء +معرفة وجود الشيت ذات الاسم المحددصفحة.rar

بارك الله فيك أستاذي القدير جزاك الله كل الخير وزادك الله من علمه

أخي ا لكريم الواضح أنك لم تفهم قصدي أنا أريد تقدم progress لا علاقة له بالشيت إن أمكن ذلك للتوضيح أنا ها progress أريد أن أعمل به شاشة إفتتاحية Sub code() Application.ScreenUpdating = False Dim i As Integer, j As Integer, pctCompl As Single Sheet1.Cells.Clear For i = 1 To 100 For j = 1 To 2000 Cells(i, 1).Value = "" Next j pctCompl = i progress pctCompl Next i End Sub

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

تفضل أستاذي progress.rar

طلب تعديل على هذا الكود progress أنا أريده عند تشغيل الفورم لا يكتب الأرقام في الخلية A1 إلى A100 Sub code() Dim i As Integer, j As Integer, pctCompl As Single Sheet1.Cells.Clear For i = 1 To 100 For j = 1 To 1000 Cells(i, 1).Value = j Next j pctCompl = i progress pctCompl Next i End Sub

الأخ يقصد عند تشغيل الفورم يظهر تنسيق التاريخ كما في الشكل التالي

الأروع مروك أخي وفيك بارك الله أخي الغالي ربي يحفظك

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