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

**۩◊۩ أبو حنين ۩◊۩** · مارس 13, 2014

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

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

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

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

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

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 بواسطه ۩◊۩ أبو حنين ۩◊۩

**حمادة باشا** · مارس 13, 2014

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

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

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

تقبل تحياتي

**۩◊۩ أبو حنين ۩◊۩** · مارس 14, 2014

السلام عليكم

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

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

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

بهعا معادلات

المرالد

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

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

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

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

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

جزاك الله خير

**دغيدى** · مارس 14, 2014

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

أخى الكريم

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

**۩◊۩ أبو حنين ۩◊۩** · مارس 14, 2014

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

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

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

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

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

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

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

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

ahmed58 · مارس 14, 2014

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

**۩◊۩ أبو حنين ۩◊۩** · مارس 14, 2014

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

ahmed58

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

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

**حمادة باشا** · مارس 14, 2014

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

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

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

TIME SHEET KAL.A.rar

**بن علية حاجي** · مارس 14, 2014

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

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

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

أخوك بن علية

**۩◊۩ أبو حنين ۩◊۩** · مارس 14, 2014

السلام عليكم

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

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

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

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 بواسطه ۩◊۩ أبو حنين ۩◊۩

**۩◊۩ أبو حنين ۩◊۩** · مارس 15, 2014

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

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

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

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

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

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

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

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

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

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

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

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

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

mhassan7222 · مارس 16, 2014

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

**۩◊۩ أبو حنين ۩◊۩** · مارس 16, 2014

السلام عليكم

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

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

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

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

15 هو اليوم

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

Book1.rar

تسجيل الدخول

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

الردود الموصى بها

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

حمادة باشا

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

دغيدى

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

ahmed58

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

حمادة باشا

بن علية حاجي

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

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

mhassan7222

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

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information