كود توليد الارقام

[jack305]

ما اريده هو عندما   انقر  في   اي خلية  من اي  عمود يبدا  منها توليد الارقام

لقد وجدت  ملفا في  الموقع  ولكن هناك توليد فقط في  عمود واحد ومن الخلية الاولى فقط

ما اريده  هو  بداية التوليد  من الخلية التي  انقر فيها 

مع امكانية التوليد في  اي  عمود   ضمن الجدول

وشكرا

مثل هذا الملف  لكن في  هذا الملف  التوليد فقط في  عمود واحد ومن الخلية الاولى

ww.xls

[سليم حاصبيا]

Try this File

 

Jack_Numeration.xlsm

[jack305]

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

الترقيم ونهايته  

و شكرا اخي  الفاضل  على جهدك

[سليم حاصبيا]

تم التعديل

الشيت Salim  من هذا الملف

Jack_Numeration_1.xlsm

[jack305]

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

هذه الصفوف لا يمكن لصقها

ها من الممكن  تعديل  هذا الكود ب ليعمل  حيث  عند النقر  بخلية ما  يبدا منها التوليد

و يكون يشمل الاعمدة وشكرا

Sub AutoNumbering()

ActiveCell = ActiveCelltiveCell
NS:
A = Application.InputBox("أدخل أول ر قم في السلسلة التي تريد إنشاؤها", "أول رقم")
B = Application.InputBox("أدخل آخر ر قم في السلسلة التي تريد إنشاؤها", "آخر رقم")

If A = False Or B = False Then
Exit Sub
ElseIf A = "" Or B = "" Then
MsgBox "!تأكد من إدخال الأرقام بشكل صحيح", vbExclamation, "إدخال خاطئ"
Else

If [IV65536] = 1 Then
ActiveCell = A
Else: Columns(4).Rows(65536).End(xlUp).Select
If ActiveCell = "" Then
ActiveCell = A
Else: ActiveCell.Offset(1, 0).Select
Selection = A
End If
End If
ActiveCell.DataSeries xlColumns, , , 1, B
End If

If Application.WorksheetFunction.CountA(Columns(ActiveCell.Column)) = 1 Then
ActiveCell.ClearContents
Beep
If MsgBox("أول رقم في السلسلة أكبر من آخر رقم .. هل تود إعادة المحاولة؟", vbQuestion + vbYesNo, "إدخال خاطئ") = vbNo Then
Exit Sub
Else: GoTo NS
End If
End If

Beep
If MsgBox("هل تود إنشاء سلسلة رقمية أخرى؟", vbYesNo + vbQuestion, "إنشاء سلسلة أخرى") = vbNo Then
Exit Sub

Else: GoTo NS

End If
End Sub

 

 

[سليم حاصبيا]

صديقى 

انا وضعت لك كود (جسب طلبك) ولست مسؤولاً عن ما يضعه الغير ان كان صحيحاً ام لا

[jack305]

شكرا