۩◊۩ أبو حنين ۩◊۩ قام بنشر أبريل 6, 2015 مشاركة قام بنشر أبريل 6, 2015 السلام عليكم الاخوة الكرام ارجو المساعده فى تصحيح الخطاء فى الاكواد المرفقه كود يقوم بإضافه عام على سنوات السن وسنوات الخبرة و كود يقوم بحذف عام من سنوات السن وسنوات الخبره اى العمود K & H على ان يطبق الكود على هذا الشيت فقط جزاكم الله كل الخير اضافى وحذف عام.rar رابط هذا التعليق شارك More sharing options...
أفضل إجابة ۩◊۩ أبو حنين ۩◊۩ قام بنشر أبريل 6, 2015 الكاتب أفضل إجابة مشاركة قام بنشر أبريل 6, 2015 جزاكم الله خيرا تم البحث وايجاد الحل باللمنتدى 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 رابط هذا التعليق شارك More sharing options...
حمادة عمر قام بنشر أبريل 6, 2015 مشاركة قام بنشر أبريل 6, 2015 ررائع اخي الحبيب / ابو حنين انت تجد الحل وتضعه بنفسك ليستفيد منه غيرك في حالة البحث عن مثل هذا الموضوع تقبل خالص تحياتي رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.