المساعده فى تطبيق كود اضافه عام وحذف عام

[۩◊۩ أبو حنين ۩◊۩]

السلام عليكم

الاخوة الكرام

ارجو المساعده فى تصحيح الخطاء فى الاكواد المرفقه

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

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

اى العمود K    &   H

على ان يطبق الكود على هذا الشيت فقط

جزاكم الله كل الخير

 

 

اضافى وحذف عام.rar

[۩◊۩ أبو حنين ۩◊۩]

جزاكم الله خيرا تم البحث وايجاد الحل باللمنتدى

 

Public ss As Byte

Sub addition1()
On Error Resume Next
pass = "240"
sama = InputBox("برجاء ادخل كلمة المرور")
If sama <> pass Then
ss = ss + 1
MsgBox ("كلمةالمرور خطاء ...الادخال الخاطئ اكثر من 3 محاولات يغلق البرنامج" & Chr(10) & " " & "باقى لك عدد" & " " & 3 - ss & " " & "محاولة")
If ss >= 3 Then
Application.Quit
End If
Exit Sub
End If
Dim ER, R, SH
For SH = 2 To 2
 Application.ScreenUpdating = False
Sheets(SH).Select
Sheets(SH).Unprotect "5240"
ER = Sheets(SH).UsedRange.Rows.Count
For R = 8 To ER
If WorksheetFunction.IsNumber(Cells(R, 8)) = True And _
Cells(R, 8) <> 0 Then Cells(R, 8) = Cells(R, 8) + 1
If WorksheetFunction.IsNumber(Cells(R, 11)) = True And _
Cells(R, 11) <> 0 Then Cells(R, 11) = Cells(R, 11) + 1
Next R
On Error Resume Next
Application.ScreenUpdating = True
MsgBox "تم اضافة عام للخبرة والسن ... وشكرا.." & CHR10 & Sheets(SH).Name, vbMsgBoxRight, "الحمدلله"
Sheets(SH).Protect "5240"
Next SH
End Sub
Sub remove1()
On Error Resume Next
pass = "240"
sama = InputBox("برجاء ادخل كلمة المرور")
If sama <> pass Then
ss = ss + 1
MsgBox ("كلمةالمرور خطاء ...الادخال الخاطئ اكثر من 3 محاولات يغلق البرنامج" & Chr(10) & " " & "باقى لك عدد" & " " & 3 - ss & " " & "محاولة")
If ss >= 3 Then
Application.Quit
End If
Exit Sub
End If
Dim ER, R, SH
For SH = 2 To 2
 Application.ScreenUpdating = False
Sheets(SH).Select
Sheets(SH).Unprotect "5240"
ER = Sheets(SH).UsedRange.Rows.Count
For R = 8 To ER
If WorksheetFunction.IsNumber(Cells(R, 8)) = True And _
Cells(R, 8) <> 0 Then Cells(R, 8) = Cells(R, 8) - 1
If WorksheetFunction.IsNumber(Cells(R, 11)) = True And _
Cells(R, 11) <> 0 Then Cells(R, 11) = Cells(R, 11) - 1
Next R
On Error Resume Next
Application.ScreenUpdating = True
MsgBox "تم حذف من الخبرة والسن ... وشكرا.." & CHR10 & Sheets(SH).Name, vbMsgBoxRight, "الحمدلله"
Sheets(SH).Protect "5240"
Next SH
End Sub

[حمادة عمر]

ررائع اخي الحبيب / ابو حنين

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

في حالة البحث عن مثل هذا الموضوع

تقبل خالص تحياتي