اذهب الي المحتوي
أوفيسنا

طلب كود او معادلة للترقيم التلقائي برقم الصفحة


الردود الموصى بها

بسم الله الرحمن الرحيم الاخوة الافاضل بعد التحية برجاء المساعدة في الملف المرفق مطلوب معادلة للترقيم التلقائي لخلية برقم الصفحة

  كما هو موضح بالمرفق     { المطلوب ان يكون رقم الكرت = نفس رقم الصفحة على ان يكون ترقيم تلقائي في حالة الغاء كرت او ايضافة كرت في نصف الملف او نقل كرت يتم تعدل رقم الكرت تلقائياً  بنفس رقم الصفحة  حيث ان الكروت تصل ال 500 كرت اقوم بتعديلهم باليد ( ترقيم يدوي )  كل مرة يتم نقل اوحذف او إيضافة كرت   

ارجو الافادة   

 جزاك الله عنا كل خير

 

1.rar

رابط هذا التعليق
شارك

ضع الكود التالي في حدث المصنف ... سيعمل الكود عند تنشبط ورقة العمل (جرب الانتقال لورقة أخرى وارجع لورقة العمل وسيعمل الكود)

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Sh.Range("F6").Value = Sh.Name
End Sub

 

رابط هذا التعليق
شارك

2 دقائق مضت, ياسر خليل أبو البراء said:

ضع الكود التالي في حدث المصنف ... سيعمل الكود عند تنشبط ورقة العمل (جرب الانتقال لورقة أخرى وارجع لورقة العمل وسيعمل الكود)


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Sh.Range("F6").Value = Sh.Name
End Sub

 

اخي ياسر

لا اعرف اذا كنت اطلعت على الملف يشكل جيد او لا  لان كل شيت تحتوي على اكثر من كرت بينهم  تسلسل 30

رابط هذا التعليق
شارك

بارك الله فيك أخي الحبيب سليم

اطلعت على الملف ووضعت الكود بناء على فهمته من الشرح وإن كان غير ذلك ننتظر رد الأخ السائل ..

جزيت خيراً على الاهتمام بالموضوع .. تقبل وافر تقديري واحترامي

رابط هذا التعليق
شارك

1 دقيقه مضت, ياسر خليل أبو البراء said:

بارك الله فيك أخي الحبيب سليم

اطلعت على الملف ووضعت الكود بناء على فهمته من الشرح وإن كان غير ذلك ننتظر رد الأخ السائل ..

جزيت خيراً على الاهتمام بالموضوع .. تقبل وافر تقديري واحترامي

انا سبقتك الى ذلك بهذا الكود عسى ان ينال الاعجاب

Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
find_row
End Sub
'=============================================================
Sub find_row()
Dim my_sh As Worksheet
Dim rg_to_find As Range
Dim search_word As String
Dim r, r1 As Integer

search_word = "رقم الكرت"
Set my_sh = ActiveSheet
 Set rg_to_find = my_sh.Range("e:e").Find(search_word, lookat:=xlWhole)
  If Not rg_to_find Is Nothing Then r1 = rg_to_find.Row: Cells(r1, "f") = my_sh.Name
   
    Do Until r1 = r
            Set rg_to_find = my_sh.Range("e:e").FindNext(after:=rg_to_find)
            r = rg_to_find.Row
            Cells(r, "f") = my_sh.Name
     Loop
 End Sub

 

رابط هذا التعليق
شارك

السلام عليكم ورحمة الله

جرب ان تضع هذا الكود فى حدث الصفحة

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 6 Then Exit Sub
Dim LR As Long, R As Integer, x As Integer
lngLstRow = ActiveSheet.UsedRange.Rows.Count
For R = 6 To lngLstRow Step 30
If True Then
x = x + 1
Cells(R, "F").Value = x
End If
Next
End Sub

 

رابط هذا التعليق
شارك

19 دقائق مضت, زيزو العجوز said:

السلام عليكم ورحمة الله

جرب ان تضع هذا الكود فى حدث الصفحة


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 6 Then Exit Sub
Dim LR As Long, R As Integer, x As Integer
lngLstRow = ActiveSheet.UsedRange.Rows.Count
For R = 6 To lngLstRow Step 30
If True Then
x = x + 1
Cells(R, "F").Value = x
End If
Next
End Sub

 

اخي زيزو الكود الذي رفعته يعمل بشكل ممتاز في حال كان تسلسل رقم الكرت (كل 30 صف) فقط و في حال الزيادة او النقصان تختلط الامور

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

فالافضل استعمال دالة Find حتى نجد الكلمة المناسية ونضع بجانبها اسم الصفحة

و اظن ان الحدث SelectionChange لا ضرورة له لان الكود يجب ان يعمل مرة واحدة عند تنشيط الصفحة فقط وليس عند اي تغيير في تحديد اي خلية من العامود السادس مما يثقل الملف بشكل ملحوظ

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
×
×
  • اضف...

Important Information