كود حذف ملف الاكسل

عدد المساهمات : 3 تاريخ التسجيل : 05/07/2019

تحية طيبة

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

الاخ خالد

اهلا بك

اليك الكود

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

Sub ClearSheet()
Dim Ddate As Date
Ddate = "28/07/2019"

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

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

Private Sub Workbook_Open()
ClearSheet
End Sub

اليك كود اخر

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

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

كود اخر

بيحذف كل البيانات فى الملف مع رسالة
Private Sub Workbook_Open()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Date > #30/10/2019# 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 1/10/2019 "
End If
End Sub

كود مع الشرح

Private Sub Workbook_Open()
'يقوم الكود بمسح محتويات الخلايا في كافة أوراق العمل بعد تاريخ محدد
'------------------------------------------------------------------
'الإعلان عن المتغيرات
Dim SH As Worksheet
'الإعلان عن ثابت من النوع تاريخ ليمثل التاريخ المراد العمل عليه في الكود
Const MyDate = #30/10/2019#
'إلغاء خاصية اهتزاز الشاشة
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

_________________

لا تعطيني سمكة ... و لكن علمني كيف أصطاد السمك

من أحب الله رأى كل شئ جميلا

مع تحياتى مجدى يونس

» صور فى تعليق فى ملف الاكسل
» تعلم الاكسل الترحيل
» تعلم الاكسل بالشرح
» شرح دوال الاكسل INDIRECT
» تعلم الاكسل بالشرح