كود عمل زيادة واضافة تلقائية بإستمرار عند الإدخال

[أبو أيمن٤٩]

تم عمل شيت لوضع الدرجات أثناء حضور الصلاة 

أرجوا منكم المساعدة في كيفة الحصول على المجموع

مثل ما هو موضح في الشيت

الصلاة١.xlsm

[Ali Mohamed Ali]

وذلك بوضح هذه الأكواد بحدذ الصفحة

Public oldval As Double
Sub KH_TEST()
 oldval = 0
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If [x1] = False Then GoTo 1
If Not Intersect(Target, Range("C3:m101")) Is Nothing Then
    Application.EnableEvents = False
    If IsNumeric(Target) Then _
    Target = oldval + Target Else Target = oldval
      Application.EnableEvents = True
End If
1 End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If [x1] = False Then GoTo 1
If Not Intersect(Target, Range("C3:m101")) Is Nothing Then
    Application.EnableEvents = False
    If IsNumeric(Target) Then oldval = Target Else oldval = 0
    Application.EnableEvents = True
End If
1 End Sub

 

الصلاة١.xlsm

[عبدالفتاح في بي اكسيل]

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim xRtn As Variant
    If Selection.Count = 1 Then
        If Not Intersect(Target, Range("c:m")) Is Nothing Then
            If IsNumeric(Target) And Target <> "" Then
                xRtn = Application.InputBox("Insert your value please")
                If xRtn <> False And IsNumeric(xRtn) Then
                    Target.Value = Target + xRtn
                End If
            End If
        End If
    End If
End Sub

 

الصلاة2.xlsm

[أبو أيمن٤٩]

شكرا لك إستاذي العزيز علي وإن شاء الله في ميزان حسناتك

مشكور استاذي عبد الفتاح وإن شاء الله في ميزان حسناتك

[abouelhassan]

شكر وتقدير للاساتذة الافاضل