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

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

السلام عليكم ارجو المساعده فى

هذا الكود للاخ حماده باشا ... المعلم الكبير

وادخلت عليه بعض الاحتياجات التى تتناسب والمطلوب

اريد ان يمسح كل شئ  المعادلات والمدخلات

 فما الخطاء فى الكود

 

 

 

 

 

Private Sub Workbook_Open()
If Date >= CDate("12/03/2015") Then
    Application.ScreenUpdating = False
    Sheet1.Range("A1:OK200").ClearContents
    Sheet2.Range("A1:U4400").ClearContents
    Sheet3.Range("A1:U4400").ClearContents
    Sheet4.Range("A1:U4400").ClearContents
    Sheet5.Range("A1:U4400").ClearContents
    Sheet6.Range("A1:U4400").ClearContents
    Sheet7.Range("A1:U4400").ClearContents
    Sheet8.Range("A1:U4400").ClearContents
    Sheet9.Range("A1:U4400").ClearContents
    Sheet10.Range("A1:U4400").ClearContents
    Sheet11.Range("A1:U4400").ClearContents
    Sheet12.Range("A1:U4400").ClearContents
    Sheet13.Range("A1:U4400").ClearContents
    Sheet14.Range("A1:D200").ClearContents
    Sheet15.Range("A1:N200").ClearContents
    Sheet16.Range("A1:AN400").ClearContents
    Sheet17.Range("A1:U44000").ClearContents
    With Sheet18.Range("A1:AJ400")
            .Value = .Value
    End With
    Me.Save
    Application.ScreenUpdating = True
    End If
End Sub

 

 

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

تم تعديل مارس 13, 2014 بواسطه ۩◊۩ أبو حنين ۩◊۩

[حمادة باشا]

الأخ الكريم/ ۩◊۩ أبو حنين ۩◊۩

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

فضلا أرفق الملف المحتوي للكود لمعرفة مكمن الخطأ

تقبل تحياتي

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

السلام عليكم

اخى حماده باشا

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

الشيتات من 1 الى 12 نفس الهيئه والصيغه التى تم حذفها

بهعا معادلات

المرالد

1-حذف محتوى الشيتات بالكامل مدخلات ومعادلات ...بحيث لا يبقى اى شئ فى الشيتات اى شئ

كلمه السر للشيتات 2191612

http://www.gulfup.com/?Jbb189

جزاك الله خير على اهتمامك

طلب اخير .. هلى لك ان تنظر الى العمود  G به معادلات ... هل يمكن تحويها الى كود

جزاك الله خير

[دغيدى]

If Date >= CDate("12/03/2015") Then

أخى الكريم 

التاريخ المحدد لتفعيل الكود لم يأتى بعد لأنه فى عام 2015

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

أخى الكريم ...دغيدى ...

 

يتم تغير الكود لكى يتم التفعيل 

الا انه لم ياتى بالمطلوب من ناحيه حذف جميع ما بالشيت

من مدخلات ومعادلات

يجذف المدخلات فقط

والمطلوب حذف المدخلات والمعادلات ...اى حذف اى شئ فى النطاق المحدد

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

تم تعديل مارس 14, 2014 بواسطه ۩◊۩ أبو حنين ۩◊۩

[ahmed58]

Private Sub Workbook_Open()
If Date >= CDate("12/03/2015") Then
    Application.ScreenUpdating = False
    Sheet1.Range("A1:OK200").ClearContents
    Sheet2.Range("A1:U4400").ClearContents
    Sheet3.Range("A1:U4400").ClearContents
    Sheet4.Range("A1:U4400").ClearContents
    Sheet5.Range("A1:U4400").ClearContents
    Sheet6.Range("A1:U4400").ClearContents
    Sheet7.Range("A1:U4400").ClearContents
    Sheet8.Range("A1:U4400").ClearContents
    Sheet9.Range("A1:U4400").ClearContents
    Sheet10.Range("A1:U4400").ClearContents
    Sheet11.Range("A1:U4400").ClearContents
    Sheet12.Range("A1:U4400").ClearContents
    Sheet13.Range("A1:U4400").ClearContents
    Sheet14.Range("A1:D200").ClearContents
    Sheet15.Range("A1:N200").ClearContents
    Sheet16.Range("A1:AN400").ClearContents
    Sheet17.Range("A1:U44000").ClearContents
    With Sheet18.Range("A1:AJ400")
            .Value = .Value
    End With
     Application.ScreenUpdating = True
    End If
End Sub

 

 

 

 

 

المشكلة في Me.Save

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

السلام عليكم اخى العزيز

ahmed58

جزاك الله خير  ... تم حل المشكله

اريد  استضاح  الخطاء من وجود ME.SAVE

[حمادة باشا]

الأخ الكريم/ ۩◊۩ أبو حنين ۩◊۩

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

المطلوب في المرفق - تقبل تحياتي

 

 

TIME SHEET KAL.A.rar

[بن علية حاجي]

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

 

أخي الحبيب أبو حنين، جرب الكود التالي (يجب مراعاة ومراقبة أسماء الشيتات والنطاقات التي تطبق عليها هذه العميات) :

Private Sub Workbook_Open()
Application.DisplayAlerts = False
If Date > DateValue("15/1/2015") Then
If InputBox("لطفًا... أدخل كلمة السرّ") <> "as2191612" Then
MsgBox "***عذرًا... ليس لديك الحق في استخدام البرنامج ***"
ThisWorkbook.Close
Else
MsgBox " تفضل بالدخول كلمة المرور صحيحة"

On Error Resume Next

For J = 1 To 13
    Set X = Choose(J, Sheet2, Sheet3, Sheet4, Sheet5, Sheet6, _
            Sheet7, Sheet8, Sheet9, Sheet10, Sheet11, Sheet12, Sheet13, Sheet17)
    X.Unprotect ("2191612")
    X.Range("A1:U4400").ClearContents
    X.Protect Password:="2191612"
Next J

For K = 1 To 4
    Set Y = Choose(K, Sheet1.Range("A1:OK200"), Sheet14.Range("A1:D200"), _
            Sheet17.Range("A1:AD200"), Sheet19.Range("A1:AN400"))
    Set Z = Choose(K, Sheet1, Sheet14, Sheet17, Sheet19)
    Z.Unprotect ("2191612")
    With Y
        .ClearContents
    End With
    Z.Protect Password:="2191612"
Next K

     With Sheet18
        .Unprotect ("2191612")
        .Range("A1:AJ400").Value = .Range("A1:AJ400").Value
        .Protect Password:="2191612"
     End With
     
     Me.Save

End If
End If
End Sub

 أخوك بن علية

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

السلام عليكم

الاخ الحبيب والاستاذ الكبير بن عليه حاجى  

والله لا اجد ما يستوفى تقدير جهدك معى

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

 

Private Sub Workbook_Open()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If Date > DateValue("12/03/2014") Then
    For i = 1 To Sheets.Count
        With Sheets(i)
            If .ProtectContents Then
                .Unprotect (2191612)
                .UsedRange.ClearContents
                .Protect (2191612)
            Else
                .UsedRange.ClearContents
            End If
        End With
    Next i
    Me.Save
    MsgBox "ÃäÊåÊ ÝÊÑÉ ÅÓÊÎÏÇã ÇáãáÝ", vbInformation
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

اين اسماء الشيتان فى الكود

وهل  

( With Sheets(i

المقصود بها كل الشيتات

اسال الله عز وجل ان يجعل ذلك فى ميزان حسناتك

 

 

 

 

تم تعديل مارس 14, 2014 بواسطه ۩◊۩ أبو حنين ۩◊۩

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

أخى الكريم حماده باشا

تقبا اعتزارى لتاخرى بالرد  

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

حل متاز جدا سلمت يداك

واسال الله ات يكون فى ميزان حسناتك

اقدر عملك شكراَ امتنانا لمجهودك الكبير

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

سلمت يداك بكل خير

 

 

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

والتى بالعمود g والخاصه ببدل الصحراء الى كود

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

سلمت يداك  على ذلك المجهود الرائع

تم تعديل مارس 15, 2014 بواسطه ۩◊۩ أبو حنين ۩◊۩

[mhassan7222]

الاخ العزيز جزاك الله خير برجاء اعطائ شيت اقوم بدخال البيانات عليه والارقام  وعند تاريخ محدد يقوم بمس البيانات تلقائى

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

السلام عليكم

اخى العزيز تفضل الملف

سوف يتم حزف الملف شهر 1 يوم 15 سنه 2015

 

If Date > CDate(#1/15/2015#) Then

 

يراعى ان 1 هو الشهر

15 هو اليوم

 

ارجو ان يفى الامر بالغرض

Book1.rar