هذا الكود يقوم بكتابة الأرقام حسب ما تحدد أنت
الكود يلزمه زر لتنفيذ الأمر أرجو أن تنجحوا
---------------------------------------------------------------------------------------------------------------------------------------------------
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(ActiveCell.Column).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