اذهب الي المحتوي
أوفيسنا

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

قام بنشر

السلام عليكم

شكراً اخ طارق على سرعة الرد

مرفق ملف اكسل يحذف نفسة بعد 30 يوم استخدام

ارجو التعديل علية بحيث يتم حذفه فى تاريخ محدد وليكن مثلا 1 / 10 / 2011

وشكرا

الملف يحذف نفسه بعد 30يوم استعمال.rar

قام بنشر

السلام عليكم

أخي الكريم

أضف هذه الإضافة للكود

	x = #10/1/2011#

	If Date > x Then Kill_Myself

ليصبح Private Sub Kill_Myself() .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End Sub





Option Explicit



Private Sub Workbook_Open()


	Dim lInitialDate As Long


	On Error Resume Next


	lInitialDate = Evaluate("InitialDate")


	If Err.Number = 13 Then

    	Me.Names.Add "InitialDate", Date, False

    	Me.Save

	End If


	x = #10/1/2011#

	If Date > x Then Kill_Myself


End Sub



Private Sub Kill_Myself()


	.Saved = True

	.ChangeFileAccess xlReadOnly

	Kill .FullName

	.Close False


End Sub

قام بنشر (معدل)

السلام عليكم

استاذ طارق

عند وضع الكود فى الملف ظهرت رسالة خطأ كما هو بالمرفق

ارجو تجربة المرفق والتعديل حتى لا تظهر رسالة الخطأ

ارجو تعديل التاريخ الى 1 / 9 / 2011 لكى نتمكن من تجربة الملف هل سيحذف نفسه أم لا

أخيراً اشكرك على الإهتمام وجزاك الله خيراً

الملف يحذف نفسه بعد 30 يوم استعمال.rar

تم تعديل بواسطه حسن محمدسليم عبدالحميد
قام بنشر

السلام عليكم

فعلا أخي الكود من الأول كان يلزمه إستكمال طفيف

الكود المضبوط




Option Explicit



Private Sub Workbook_Open()


	Dim lInitialDate As Long, x As Date


	On Error Resume Next


	lInitialDate = Evaluate("InitialDate")


	If Err.Number = 13 Then

    	Me.Names.Add "InitialDate", Date, False

    	Me.Save

	End If


	x = #9/1/2011#

	If Date > x Then Kill_Myself


End Sub



Private Sub Kill_Myself()


	With ActiveWorkbook

	.Saved = True

	.ChangeFileAccess xlReadOnly

	Kill .FullName

	.Close False

	End With

End Sub

والملف المرفق به التاريخ 1/9/2011 والكود المضبوط

تفضل

الملف يحذف نفسه بعد 30يوم استعمال.rar

قام بنشر

السلام عليكم استاذ طارق واستاذ عبدالله المجرب " أبو أحمد "

استاذ طارق الملف فعلاً مضبوط ويعمل بشكل صحيح جداً

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

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

  • 1 year later...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information