شرح كيف يتم تفعيل كود تسلسل مع كود اخر يوجد في الورقة

[محمد عبدالسلام]

تواجهني مشكلة في هذا الكود اريد شرح كيف يتم جمع كودتسلسل مع هدا الكود الااخر في السفل

 

 

 

 

Private Sub Worksheet_Change(ByVal Target As Range)
'كود عمل ترقيم متسلسل
If Target.Column = 5 Then
Range("c10:c60").ClearContents
s = 0
'متغير يشير الى ان بدايه الترقيم  الرقم صفر
For T = 5 To 20000
' متغير يشير ان الترقيم سيبدا من السطر الاول 1 الى السطر 100
If Cells(T, 5) > "" Then
s = s + 1
Cells(T, 5).Offset(0, -2).Value = s
End If
Next
End If
End Sub

 

 

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 11 Then Exit Sub
If Target.Address = [i3].Address Then
 
n = [i3]

          If WorksheetFunction.CountIf(Sheets("Customers").[C6:C10000], [i3]) <> 0 Then
                  Dim message As Integer
message = MsgBox("اضغط زر YES  من اجل مشاهدة البيانات  " & vbNewLine & "----------------------------" _
& vbNewLine & "او اضغط زر NO لالغاء الامر  " & vbNewLine & "==========================================" _
& vbNewLine & "Click Yes to SHOW DATA" & vbNewLine & "----------------------------" _
& vbNewLine & "Click NO EXIT", vbYesNoCancel, "تعليمات-Login")
'----------------------------------------------------------------------------------------------------------
If message = 6 Then

'-------------------------------------------------------------------
'---------------------------------------------------------------------
ElseIf message = 7 Then
'-------------------------------------------------------------------
'---------------------------------------------------------------------
ElseIf message = 8 Then
Exit Sub
End If

         ' MsgBox "هذه الفاتروره موجوده من قبل"
        '  ElseIf WorksheetFunction.CountIf(Sheets("Customers").[C6:C10000], [i3]) = 0 Then
End If
End If
Application.ScreenUpdating = False
On Error Resume Next

If Not Intersect(Target, Range("F10:F59")) Is Nothing And IsNumeric(Target) Then
Target.Offset(0, 3).Value = Target.Value * Target.Offset(0, 2).Value
End If
If Not Intersect(Target, Range("H10:H59")) Is Nothing And IsNumeric(Target) Then
Target.Offset(0, 1).Value = Target.Value * Target.Offset(0, -2).Value
End If

End Sub

 

[صالح احمد المريسي]

اضف ملف لتطبيق علية

[محمد عبدالسلام]

جزاك الله خير  اخي صالح احمد المريسي على الاهتمام الموضوع

لقد تما رفع الملف من خرج المنتدى حجم الملف كبر

 

ربط الملف

http://download1494.mediafire.com/7v7nibu3xr8g/lx3k2c4z52copc0/تمسنا_2015_07_21.zipp

تم تعديل أغسطس 27, 2015 بواسطه محمد عبدالسلام

[خالد الرشيدى]

قم بمسح كود الترقيم

وفى الكود الاخر ...فى نهايتة... اى قبل الجملة

End Sub

الصق هذا الكود

If Not Intersect(Target, Range("E10:E60")) Is Nothing Then
Range("c10:c60").ClearContents
s = 0
For T = 10 To 60
If Cells(T, 5) > "" Then
s = s + 1
Cells(T, 5).Offset(0, -2).Value = s
End If
Next
End If

تقبل تحياتى

[محمد عبدالسلام]

جزاك الله اخي خالد الرشيدى   لم يعمل الكود معي

تم تعديل أغسطس 27, 2015 بواسطه محمد عبدالسلام

[KHMB]

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

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