الجموعي

السلام عليكم ورحمة الله تعالى وبركاته أقدم لكم هذه الهدية البسيطة والمتواضعه وهي عبارة عن فورم لمعرفة رموز الالوان RGB color codes chart صورة الفورم وفي الأخير اتمنى هذا العمل ان ينال إعجابكم في إنتظار أرائكم وإقتراحاتكم تقبلو خالص تحياتي RGB color.rar

تفضل أخي Private Sub UserForm_Activate() If Range("A1").Value = "1" Then Me.TextBox1.Value = Cells(1, 1) Me.TextBox1.BackColor = vbGreen End If If Range("A1").Value = "0" Then Me.TextBox1.Value = Cells(1, 1) Me.TextBox1.BackColor = vbRed End If End Sub إثراء للموضوع كود أخر للتحكم في الألوان ' اللون الأخضر Me.TextBox1.BackColor = RGB(0, 255, 0) ' اللون الأحمر Me.TextBox1.BackColor = RGB(255, 0, 0)

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

السلام عليكم أخي الكريم بالنسبة لكود التنقل بين الصفحات الكود التالي يعمل جيدا Private Sub UserForm_Initialize() Dim i As Integer On Error Resume Next With ListBox1 For i = 1 To Sheets.Count .AddItem Sheets(i).Name Next i End With Me.ListBox2.List = Sheets("bb").Range("Q7").Resize(10, 1).Value End Sub Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If Me.ListBox1.Value = "" Then: Exit Sub Sheets(ListBox1.Value).Select End Sub Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If Me.ListBox2.Value = "" Then: Exit Sub Sheets(ListBox2.Value).Select End Sub

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

أخي أعرف انه طلب غير كاف جرب المرفق التالي بواسطة المعادلات قم بإختيار إسم المصرف سيتم كتابة رقم الصك تلقائيا 3110.rar

أستاذي الفاضل شاكر مرورك بارك الله فيك إن أمكن التعديل على هذالكود Sub Name() Dim strName As String Dim i As Integer strName = Application.InputBox("الرجاء إدخال إسم الفرع ورقم اللجنة") On Error Resume Next For i = 1 To Sheets.Count Sheets(i).Select Range("c6") = strName Next Sheets(1).Select End Sub بحيث عند ظهور رسالة مربع الكتابة وعدم الكتابة الضغط على زر خروج أو إلغاء الامر في الخلايا المراد الكتابة فيها تظهر علامة false وعند الضغط على زر موافق في حالة عدم الكتابة في مربع الرسالة تمسح البيانات

تم التعديل على كود تغيير العنوان Sub Name() Dim strName As String Dim i As Integer strName = Application.InputBox("الرجاء إدخال إسم الفرع ورقم اللجنة") On Error Resume Next For i = 1 To Sheets.Count Sheets(i).Select Range("c6") = strName Next Sheets(1).Select End Sub

شكرا أستاذي على الشرح ودي وتقديري

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

بارك الله فيك أستاذي على هذا التعديل الرائع جزاك الله كل الخير إستفسار بسيط RR ماذا تعني رغم انك لم تصرح بها RR = MsgBox

أخي الفاضل تم تعديل على زر إعادة تسمية العنوان وذلك بإختيار أولا إسم الصغحة وبعد دلك تظهر لك رسالة الرجاء إدخال إسم الفرع ورقم اللجنة Sub Name() Dim strName As String Dim i As String i = Application.InputBox("الرجاء إدخال رقم الورقة التي تريد تعديل إسم الفرع ورقم اللجنة") Sheets(i).Select strName = Application.InputBox("الرجاء إدخال إسم الفرع ورقم اللجنة") Range("c6") = strName End Sub وتم التعديل أيضا على زر مسح البيانات وإختصاره بهذا الكود Sub Clear() Dim i As Integer For i = 1 To Sheets.Count Sheets(i).Select Range("B12:C36").ClearContents Range("A1").Select Next End Sub

بالنسبة للحفظ على القرص D قم بإنشاء موديل جديد وضغط به الكود التالي Sub save() ActiveWorkbook.SaveAs Filename:="D:\الجرد السنوى.xls", FileFormat:=xlExcel8 _ , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False End Sub وعن طريق زر حفظ استدعي الأمر التالي وبالنسبة لتعديل الإسم نفس الطريقة السابقة أضف الكود التالي في زر تسمية العنوان ملاحظة هذا الكود يعمل على تغيير الإسم في جميع الصفحات Sub Name() Dim strName As String strName = Application.InputBox("الرجاء إدخال إسم الفرع ورقم اللجنة") Range("c6") = strName End Sub ,بالنسبة لزر أمر هذا هو الكود Sub Clear() Sheets(1).Select Range("B12:C36").ClearContents Range("A1").Select Sheets(2).Select Range("B12:C36").ClearContents Range("A1").Select Sheets(3).Select Range("B12:C36").ClearContents Range("A1").Select End Sub

أستاذي إبن مصر معذرة مني ظننت أن الكود مفهوم تفضل المرفق عايز إضافات من عندك مثلا رسالة الترحيب تكون بإسم المستخدم إختيار الاسماء عن طريق كمبوبوكس مثلا واي إضافة استاذي PWD.rar

تم إيجاد الحل بهذا التعديل Private Sub CommandButton1_Click() Dim password As String If TextBox1.Text = "aa" And TextBox2.Text = "1111" Then password = "True" MsgBox "مرحبا بك" Unload Me Sheets(2).Select ElseIf TextBox1.Text = "bb" And TextBox2.Text = "2222" Then password = "True" MsgBox "مرحبا بك" Unload Me Sheets(3).Select Else MsgBox "إسم المستخدم/كلمة المرور خاطئة.حاول مرة ثانية" TextBox1.Text = vbNullString TextBox2.Text = vbNullString TextBox1.SetFocus End If End Sub

تم تعديلي على هذا الكود لتسهيل المهمة عليكم الكود يعمل جيدا لكن الصفحة تنشط وتظهر رسالة مرحبا أريد عند الضغط على زر دخول تظهر الرسالة مرحبا ومن بعد تنشط الصفحة Private Sub CommandButton1_Click() Dim password As String If TextBox1.Text = "aa" And TextBox2.Text = "1111" Then password = "True" End If If password = "True" Then Unload Me Sheets(2).Select ElseIf TextBox1.Text = "bb" And TextBox2.Text = "2222" Then password = "True" Unload Me Sheets(3).Select End If If password = "True" Then MsgBox "مرحبا بك" Else MsgBox "إسم المستخدم/كلمة المرور خاطئة.حاول مرة ثانية" TextBox1.Text = vbNullString TextBox2.Text = vbNullString TextBox1.SetFocus End If End Sub

السلام عليكم ورحمة الله تعالى وبركاته الرجاء المساعدة في الكود التالي يعمل بشكل ممتاز Private Sub CommandButton1_Click() Dim password As String If TextBox1.Text = "aa" And TextBox2.Text = "1111" Then password = "True" End If If password = "True" Then MsgBox "مرحبا بك" Unload Me Sheets(2).Select Else MsgBox "إسم المستخدم/كلمة المرور خاطئة.حاول مرة ثانية" TextBox1.Text = vbNullString TextBox2.Text = vbNullString TextBox1.SetFocus End If End Sub الكود الذي اريد التعديل عليه بحيث أضفت مستخدم ثان وكلمة مرور ثانية أريد بعد إدخال الكود ينشط الصفحة 3 حاولت ولم تزبط معي Private Sub CommandButton1_Click() Dim password As String If TextBox1.Text = "aa" And TextBox2.Text = "1111" Then password = "True" End If If password = "True" Then MsgBox "مرحبا بك" Unload Me Sheets(2).Select If TextBox1.Text = "bb" And TextBox2.Text = "2222" Then password = "True" End If If password = "True" Then MsgBox "مرحبا بك" Unload Me Sheets(3).Select Else MsgBox "إسم المستخدم/كلمة المرور خاطئة.حاول مرة ثانية" TextBox1.Text = vbNullString TextBox2.Text = vbNullString TextBox1.SetFocus End If End If End Sub

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

أخي الكريم الواضح أنها معمولة بالوورد

يعني اذهب الى رقم 1 ... وبعدها على طول ليس هناك اكواد اخري بل End Sub مباشرة .. حتى ينهي الكود ولا يكمل الأسطر المتبقية ... ليس بالضرورة 1 ممكن 2 او اى رقم ... مجرد اشارة لسطر كود يذهب اليه وهناك اعضاء افاضل يكتبون مكانها Exit Sub ... اتمنى ان تكون المعلومة وضحت تحياتي بارك الله فيك استاذي على التوضيح استاذي عند كتابة رقم سر خاطى تظهررسالة بان كلمة المرو خاطئة عند الضغط على موافق تظهر البيانات وتختفي بسرعة هل لاحظت ذلك هل فيه إمكانية لعدم ظهور البيانات

فعلا هو المطلوب أستاذي ياريت شرح بسيط لهذه الجزئية GoTo 1 1 End Sub

تم إضافة المرفق استاذي في المشاركة 1

إضافة بسيطة استاذي اعتقد أنك نسيتها وهي عند إدخال الرقم الوظيفى تظهر السجلات و لكن يختفى رأس الجدول invigilations_4.rar نعم نسيت تعديل الرنج من ادارة الاسماء مع اني عملتها فيما بعد هذا المرفق به تعديلات بسيطة كلمة الحماية في العمود j المخفي اذا اردت تغيرها غيرهنا من العمود j كي لا تواجهك مشكلة في الكود لانه يعمل من الخلية مع زر الحماية و فك الحماية اذا اردت اظهار القائمة كاملة لاظافة جديد للقائمة اترك خانة البحث فارغة و اظغط على زر البحث بارك الله أستاذي افدتنا بهذه الإضافات الرائعة جزاك الله كل الخير ودي وتقديري

الرجاء تعديل على هذا الكود الكود يعمل عند الضغط على CheckBox واقوم بإدخال كلمة المرور وتطلع لي رسالة كلمة مرور صحيحة ولكن نافذه إدخال كلمة السر تظهر من جديد وأنا أريدها عند الضغط فقط: مثلا القيمة true في CheckBox وعند إدخال كلمة المرور تختفي الصفوف المختارة وعندما تكون القيمة false في CheckBox تظهر الصفوف المخفية Private Sub CheckBox1_Click() Dim PASS As String: PASS = "1234" With CheckBox1 = 1 If Application.InputBox("تصريح دخول الرجاء إدخال كلمة المرور حتى تتمكن من مشاهدة البيانات") <> PASS Then MsgBox (" عفوا كلمة المرور غير صحيحة ") Else MsgBox (" كلمة المرور صحيحة ") Call Hidden1 End If End With With CheckBox1 = 0 If Application.InputBox("تصريح دخول الرجاء إدخال كلمة المرور حتى تتمكن من مشاهدة البيانات") <> PASS Then MsgBox (" عفوا كلمة المرور غير صحيحة ") Else MsgBox (" كلمة المرور صحيحة ") Call Hidden0 End If End With End Sub وهذا كود ثاني Private Sub CheckBox1_Click() Dim PASS As String: PASS = "1234" With CheckBox1 = 1 If Application.InputBox("تصريح دخول الرجاء إدخال كلمة المرور حتى تتمكن من مشاهدة البيانات") <> PASS Then MsgBox (" عفوا كلمة المرور غير صحيحة ") Else MsgBox (" كلمة المرور صحيحة ") Call Hidden1 End If End With If CheckBox1 = 0 Then Call Hidden0 End If End Sub pass.rar

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