طلب ترقيم تلقائي عن طريق الفورم

[زياد عبد الجليل]

السلام على جميع الاساتذة الافاضل اما بعد اطلب من العمالقة المتميزين في هذا المنبر العربي المميز و الرائع مساعدة تتمثل في الاتي

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

فاذا بدانا الترقيم مثلا في الصفحة 1 من 1 وانتهى في 10 يجب ان يبدأ التالي في الصفحة 2 من 11 حتى نهاية الخلايا التي بها اسماء و لكم مني كل الشكر و العرفان.

ترقيم تلقائي عن طريق الفورم.rar

[Guest محمد ابو صهيب]

 Option Explicit
Dim Ws As Worksheet
Dim Lr As Integer



Private Sub ComboBox3_Change()

If ComboBox3.ListIndex = 0 Then

   Sheets("(القسم(2)".Select
     TextBox1.Visible = True
      TextBox7.Visible = False
       ElseIf ComboBox3.ListIndex = 1 Then
      Sheets("القسم(3)").Select
     TextBox1.Visible = False
    TextBox7.Visible = True
    Set Ws = Worksheets("(القسم(3)"
     Lr = Ws.Cells(Rows.Count, 2).End(xlUp).Row
         TextBox7.Value = Format(Val(Ws.Cells(Lr, 2)) + 1, "000 00")
  End If
End Sub

Private Sub CommandButton1_Click()
 
     Lr = Ws.Cells(Rows.Count, 2).End(xlUp).Row
   If ComboBox3.ListIndex = 0 Then
   Ws.Cells(Lr + 1, 2) = TextBox1.Text
   Ws.Cells(Lr + 1, 3) = TextBox2.Text
   Ws.Cells(Lr + 1, 4) = TextBox3.Text
   Ws.Cells(Lr + 1, 5) = TextBox4.Text
   Ws.Cells(Lr + 1, 6) = TextBox5.Text
   Ws.Cells(Lr + 1, 7) = ComboBox2.Text
   Ws.Cells(Lr + 1, 8) = ComboBox1.Text
   Ws.Cells(Lr + 1, 9) = TextBox6.Text
  ElseIf ComboBox3.ListIndex = 1 Then
   Ws.Cells(Lr + 1, 2) = TextBox7.Text
   Ws.Cells(Lr + 1, 3) = TextBox2.Text
   Ws.Cells(Lr + 1, 4) = TextBox3.Text
   Ws.Cells(Lr + 1, 5) = TextBox4.Text
   Ws.Cells(Lr + 1, 6) = TextBox5.Text
   Ws.Cells(Lr + 1, 7) = ComboBox2.Text
   Ws.Cells(Lr + 1, 8) = ComboBox1.Text
   Ws.Cells(Lr + 1, 9) = TextBox6.Text
   End If
   Unload Me
   UserForm1.Show
End Sub

Private Sub UserForm_Activate()
'تحديد الجنس
With ComboBox1
    .AddItem "ذكر"
    .AddItem "أنئى"
End With

With ComboBox2
    .AddItem "مكرر"
    .AddItem "غير مكرر"
End With

With ComboBox3
    .AddItem "(القسم(2"
    .AddItem "(القسم(3"
End With
 ComboBox3.ListIndex = 0
End Sub

Private Sub UserForm_Initialize()
' تحديد الافتراضي
 
   Set Ws = Sheets("(القسم(2)"
       
         Lr = Ws.Cells(Rows.Count, 2).End(xlUp).Row
         TextBox1 = Format(Val(Ws.Cells(Lr, 2)) + 1, "00 00")
   
  
  
End Sub

 

 

 

 

 

 

 

 

 

 

 

 

 

 

ترقيم تلقائي عن طريق الفورم.rar

 

تم تعديل أغسطس 15, 2016 بواسطه محمد ابو صهيب

[زياد عبد الجليل]

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

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

الترقيم الالي للخلايا عن طريق تاكس بوكس في الفورم.rar

[زياد عبد الجليل]

ارجو شرح ملف العلامة ربيع شوقي وكيف ابدأ الترقيم من الخلية b9

[شوقي ربيع]

السلام عليكم

الكود لا يحتاج الى اي تعديل ان اردت مثلا ان يبدأ الترقيم من السطر 9 كل ماعليك هو ان تجعل عنوين الجدول في السط 8 لان الكود يقراء تلقائيا اول سطر من العمود به بينات و يبداء الترقيم من السطر الذي يليه المهم ان لايكون هناك بينات فق العناوين في العمود c

سلام

[زياد عبد الجليل]

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

[زياد عبد الجليل]

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

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

أخي الكريم زياد ..

قمت بشرح الكود بالتفصيل لتتضح لك الصورة بشكل تام

وأضفت تعليق يلبي طلبك في حالة أردت أن تقوم بالترقيم في الصف رقم 9 أي الخلية B9

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

'تعريف متغير من النوع ورقة عمل
Dim ws As Worksheet

Private Sub CommandButton1_Click()
    'تعريف متغيرات من النوع رقم صحيح طويل يمثلان بداية الصفوف التي سيتم الترقيم من خلالها
    Dim lLrw1 As Long, lLrw2 As Long
    
    'إذا كان صندوق النص فارغ يتم الخروج من الإجراء الفرعي أي لا يتم تنفيذ بقية السطور التالية
    If TextBox1 = "" Then Exit Sub
    
    'تعريف متغير من النوع رقم صحيح ويحمل قيمة صندوق النص
    Dim b As Long: b = Me.TextBox1.Value
    
    'حلقة تكرارية لكل أوراق العمل بالمصنف
    For Each ws In ThisWorkbook.Sheets
    
        'تحديد أول صف سيتم التعامل معه وإدراج الترقيم به
        'لكي تجعل الترقيم يبدأ من الصف رقم 9 قم باستبدال الجملة بعد علامة يساوي بالرقم 9
        lLrw1 = ws.Cells(1, "C").End(xlDown).Row + 1
        
        'تحديد آخر صف سيتم التعامل معه وإدراج الترقيم به
        lLrw2 = ws.Cells(Rows.Count, "C").End(xlUp).Row
        
        'تعريف المتغير من النوع رقم صحيح لاستخدامه في الحلقة التكرارية
        Dim I As Long
        
        'حلقة تكرارية من أول صف إلى آخر صف
        For I = lLrw1 To lLrw2
            
            'تم إضافة هذا السطر للخروج من الحلقة التكرارية إذا كانت الخلية في العمود الثالث فارغة
            If IsEmpty(ws.Range("C" & I)) Then Exit For
            
            'وضع قيمة المتغير (القيمة التي توضع في صندوق النص) في العمود الثاني
            ws.Range("B" & I) = b
            
            'زيادة قيمة المتغير الذي يستخدم في الترقيم بمقدار واحد
            b = b + 1
            
        'الانتقال إلى الصف التالي داخل نفس الورقة
        Next I
        
    'الانتقال إلى الورقة التالية
    Next ws
End Sub

Private Sub UserForm_Initialize()
'حدث بدء تشغيل الفورم
'يقوم الكود بتعبئة الكومبوبوكس بأسماء أوراق العمل
'------------------------------------------------
    'حلقة تكرارية لكل ورقة من أوراق العمل لإضافتها إلى الكومبوبوكس
    For Each ws In ThisWorkbook.Sheets
    
        '[AddItem] سطر لإضافة اسم ورقة العمل إلى الكومبوبوكس من خلال استخدام الطريقة
        Me.ComboBox1.AddItem ws.Name
        
    'الانتقال لورقة العمل التالية
    Next ws
    
    'جعل خاصية الإندكس تساوي صفر ليظهر لك أول خيار في الكومبوبوكس
    'لو حذفت هذا السطر سيظهر الكومبوبوكس فارغ إلا إذا اخترت عنصر منها بشكل يدوي
    Me.ComboBox1.ListIndex = 0
End Sub

أرجو أن يكون الشرح مفيد ، ولا تبخل علينا بدعوات بظهر الغيب ، فما أحوجنا لتلك الدعوات

تقبل تحياتي

[زياد عبد الجليل]

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

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

الله يحفظك و يسترك ويبعد عنك كل مكروه ان شاء الله و دمت لنا مرجعا و المنتدى منبرا نلتقي لنرتقي و نتعلم فيه من كل اساتذتنا الافاضل ...بارك الله فيك

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

جزيت خيراً أخي الكريم زياد على دعواتك الطيبة المباركة ..

وإن كنت لا أحب تداخل الموضوعات (لأن الطلب لا يخص الموضوع الحالي) ولكني سأجيبك باختصار أنه يمكن وضع الكود في حدث تغيير ورقة العمل Worksheet_Change وليس حدث تحديد خلايا ورقة العمل Worksheet_SelectionChange ...

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

المهم الآن أن الموضوع الحالي قد تم حله بعون الله ...

تقبل تحياتي