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

[ابو حبيبة وحنين]

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

[ibn_egypt]

اخى الفاضل

 

تفضل الملف المرفق لعله يفي بالمطلوب .. غير التاريخ بالكود للتاريخ الذي تريد حذف محتويات الشيت بعده

 

تحياتي  

ClearAfterDate.rar

[ابو حبيبة وحنين]

متشكر لاهتمامك : ولكن لا يوجد كود

[ibn_egypt]

متشكر لاهتمامك : ولكن لا يوجد كود

 

اخى الفاضل

 

ازاى يعني لا يوجد كود، الكود لا يعمل من خلال زر أمر ... لكن بمجرد فتح الملف سيري ان كان تاريخ اليوم اكبر من التاريخ الذي حددته سيحذف بيانات الشيت .. غير ذلك يبقي الوضع كما هو عليه .... شاهد المرفق وعامة هذا هو الكود انشئ موديول جديد والصق به هذا الكود مع تغيير التاريخ للتاريخ الذي تريده

Sub ClearSheet()
Dim Ddate As Date
Ddate = "28/02/2015"

If Date > Ddate Then
Sheet1.Cells.ClearContents
End If
End Sub

وفي حدث فتح الملف الصق هذا السطر

Private Sub Workbook_Open()
ClearSheet
End Sub

تحياتي  

Code.rar

[ابو حبيبة وحنين]

 الكود مش شغال 

[ابو حبيبة وحنين]

على العموم متشكر على مجهودك  

[ibn_egypt]

ارفق الملف اللى انت شغال عليه .. يعنى افتح ملف جديد عندك وانشئ موديول جديد والصق به الكود وارفقه

 

تحياتي  

[أبو أية]

الأخ الكريم ibn_egypt جزاك الله خيرا على هذا العمل الكود يعمل بالفعل وأرجوا منك اجراء تعديل لحذف محتويات أكثر من ورقة بالملف

وشكرا لك على مجهودك الرائع

 

[أحمد مرجان]

بارك الله فيك Ibn-Egypt

[ياسر خليل أبو البراء]

الأخ أبو آية

أهلا بك عضوا جديدا في المنتدى

يرجى إرفاق ملفك بعد ضغطه للعمل عليه

[مختار حسين محمود]

السلام عليكم 

بعد اذن الأساتذة

هذا كود لحذف محتويات أكثر من ورقة عمل مع رسالة تنبية  يوضع فى حدث المصنف : ( غيّر التاريخ كما تشاء )

Private Sub Workbook_Open()
If Date > #1/30/2015# Then
For Each x In ThisWorkbook.Sheets
x.UsedRange.Clear
Next
ThisWorkbook.Save
MsgBox "sorry all data delated by mokhtar "
End If
End Sub

تحياتى

تم تعديل مارس 22, 2015 بواسطه مختار حسين محمود

[ابو حبيبة وحنين]

شكر خاص وطلب للأستاذ ibn_egypt ممكن تعدل الكود تخليه يحذف كل البيانات الموجودة في الشيتات كلها مش شيت واحد

[مختار حسين محمود]

أخى وحبيبى ابن مصر بعد اذنك حضرتك

أخى أبو حبيبة وحنين  ( ربنا يبارك لك فيهما )

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

Private Sub Workbook_Open()

Application.ScreenUpdating = False
 Application.DisplayAlerts = False

If Date > #1/30/2015# Then

For Each x In ThisWorkbook.Sheets
x.UsedRange.Clear
Next
ThisWorkbook.Save


Application.ScreenUpdating = True
 Application.DisplayAlerts = True

MsgBox "sorry all data delated after 30/1/2015 "
End If
End Sub

ضع الكود فى حدث المصنف  واكتب أى بيانات فى أى شيت احفظ واقفل الملف ثم أعد فتحه  لن تجد أى بيانات فى أى شيت

تحياتى

تم تعديل مايو 11, 2015 بواسطه مختار حسين محمود

[ابو حبيبة وحنين]

شاكر جدا بس مش فاهم ما هو حدث المصنف

[ياسر خليل أبو البراء]

الأخ أبو حبيبة وحنين

لما تروح لمحرر الأكواد عن طريق Alt + F11 مثلاً هتلاقي في نافذة المشروع Project Window أو اسمها Project - VBA Projetc هتلاقي الكائنات الموجودة في الملف .. Sheet1 و Sheet2 و هتلاقي حدث المصنف ThisWorkbook ... انقر دبل كليك وبس خلاص إنت كدا جوا الحدث ..عيش الحدث وشوف هتعرف تعيش الحدث ولا الحدث هو اللي هيعيشك

[ياسر خليل أبو البراء]

ومحبة مني إليك شرح كود الأستاذ الكبير والأخ الغالي مختار (اللي مش بيرد على تليفونات)

Private Sub Workbook_Open()
'يقوم الكود بمسح محتويات الخلايا في كافة أوراق العمل بعد تاريخ محدد
'------------------------------------------------------------------
'الإعلان عن المتغيرات
    Dim SH As Worksheet
'الإعلان عن ثابت من النوع تاريخ ليمثل التاريخ المراد العمل عليه في الكود
    Const MyDate = #1/30/2015#
'إلغاء خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
'إلغاء خاصية رسائل التنبيه
    Application.DisplayAlerts = False
'إذا تحقق الشرط وكان تاريخ اليوم أكبر من التاريخ الثابت في الكود
        If Date > MyDate Then
'حلقة تكرارية لكافة أوراق العمل
            For Each SH In ThisWorkbook.Sheets
'مسح محتويات وتنسيقات ورقة العمل في النطاق المستخدم
                SH.UsedRange.Clear
            Next
'حفظ المصنف
            ThisWorkbook.Save
'رسالة تفيد أن البيانات قد تم محوها
            MsgBox "Sorry All Data Deleted After " & MyDate
        End If
'إعادة تفعيل خاصية رسائل التنبيه
    Application.DisplayAlerts = True
'إعادة تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

ومتنسناش إحنا التلاتة بدعوة بظهر الغيب (مرضتش أقول إحنا الأربعة عشان رقم 4 من المحظورات ..) أنا وإنت وابن مصر ومختار .. ولا أقولك ادعي لكل الأعضاء (كل دعوة هتتردلك)

[ابو حبيبة وحنين]

ومحبة مني إليك شرح كود الأستاذ الكبير والأخ الغالي مختار (اللي مش بيرد على تليفونات)

Private Sub Workbook_Open()
'يقوم الكود بمسح محتويات الخلايا في كافة أوراق العمل بعد تاريخ محدد
'------------------------------------------------------------------
'الإعلان عن المتغيرات
    Dim SH As Worksheet
'الإعلان عن ثابت من النوع تاريخ ليمثل التاريخ المراد العمل عليه في الكود
    Const MyDate = #1/30/2015#
'إلغاء خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
'إلغاء خاصية رسائل التنبيه
    Application.DisplayAlerts = False
'إذا تحقق الشرط وكان تاريخ اليوم أكبر من التاريخ الثابت في الكود
        If Date > MyDate Then
'حلقة تكرارية لكافة أوراق العمل
            For Each SH In ThisWorkbook.Sheets
'مسح محتويات وتنسيقات ورقة العمل في النطاق المستخدم
                SH.UsedRange.Clear
            Next
'حفظ المصنف
            ThisWorkbook.Save
'رسالة تفيد أن البيانات قد تم محوها
            MsgBox "Sorry All Data Deleted After " & MyDate
        End If
'إعادة تفعيل خاصية رسائل التنبيه
    Application.DisplayAlerts = True
'إعادة تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

ومتنسناش إحنا التلاتة بدعوة بظهر الغيب (مرضتش أقول إحنا الأربعة عشان رقم 4 من المحظورات ..) أنا وإنت وابن مصر ومختار .. ولا أقولك ادعي لكل الأعضاء (كل دعوة هتتردلك)

لو سمحت شوف الرسالة في الصورة المرفقة 

New Picture (1).rar

[ياسر خليل أبو البراء]

الأخ الكريم أبو حبيبة وحنين

إليك الفيديو التالي علك تجد فيه ضالتك