اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

حذف كود بناء على تاريخ محدد ( تحديد صلاحيته )


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

السلام عليكم  اخوانى فى المنتدى

 

 فى البداية  ألفت نظركم أنى قدمت لكم  من قبل موضوعاً وهو حذف كود من بعد ما يشتغل مرة واحدة على الرابط

 

http://www.officena.net/ib/index.php?showtopic=57103

 

وقدمت لكم موضوعا آخر بعنوان  كود يحذف كود آخر ( كود فى قاعة المحكمة )

 

http://www.officena.net/ib/index.php?showtopic=57981

 

أما موضوع اليوم سأعرض لكم  كيف يحذف كود تلقائيا بعد تاريخ معين

 

قبل الحذف  يخبرك كم يوما باقية على الحذف .

 

ببساطة يعنى ازاى نعمل صلاحية للكود مش لملف الاكسل   .  ضع الكود التالى فى حدث المصنف

Private Sub Workbook_Open()
Dim exdate As Date
Dim vbCom As Object

    exdate = "12/03/2015"   ' حدد تاريخ بدايةالحذف
    
    If Date > exdate Then
    MsgBox "من فضلك احصل على كود جديد من الوكيل الخاص بك "
    
    Set vbCom = Application.VBE.ActiveVBProject.VBComponents
    vbCom.Remove VBComponent:=vbCom.Item("Module1")  ' حدد اسم المديول المراد حذفه
    Exit Sub
    End If
    
 
    MsgBox ("لديك " & exdate - Date & "يوم للحصول على كود جديد من الوكيل المعتمد ")
   
    Application.Save
   
End Sub




الكود المراد تحديد صلاحيته  يوضع كمديول عادى  ونثبت اسمه فى الكود السابق

 

فى الكود السابق الحذف الآلى للمديول يبدأ اعتبارا من يوم  13/03/2015  يمكنك تعديله  الى يوم قديم  لحذف المديول

 

لا تنسى تمكين الماكرو  واليكم المرفق

 

Delete a VBA Module based on date.rar

  • Like 1
رابط هذا التعليق
شارك

الأخ الحبيب مختار

بارك الله فيك وجزاك الله خير الجزاء

بقالك أسبوع في بالي (بس مش عارف أوصلك إزاي وأسأل عليك إزاي .. متبقاش تتأخر علينا .. بالي ارتاااااااااح والحمد لله)

تقبل تحياتي

رابط هذا التعليق
شارك

السلام عليكم

الأستاذ الفاضل ابراهيم ابوليلة

الأستاذ الفاضل ياسر خليل 

الأستاذ الفاضل  حكيم

بارك الله فيكم وفى مروركم الكريم 

 

بالنسبة للأخطاء  : يمكن الاستغناء  عن السطر    Application.Save     فى الكود ولاننسى تمكين الماكرو قبل فتح الملف

 

والتعديل فى المرفق التالى

(حذف كود بناء على تاريخ محدد ( تحديد صلاحيته.rar

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

الملف يعمل عندى دون حدوث أى أخطاء

 

أعمل على أوفيس 2010

 

أقترح على حضرتك انشاء ملف اكسل جديد وأن تضع الكود بدون السطر  Application.Save

Private Sub Workbook_Open()
Dim exdate As Date
Dim vbCom As Object

    exdate = "13/03/2015"   ' حدد تاريخ بدايةالحذف
    
    If Date > exdate Then
    MsgBox "من فضلك احصل على كود جديد من الوكيل الخاص بك "
    
    Set vbCom = Application.VBE.ActiveVBProject.VBComponents
    vbCom.Remove VBComponent:=vbCom.Item("Module1")  ' حدد اسم المديول المراد حذفه
    Exit Sub
    End If
    
 
    MsgBox ("لديك " & exdate - Date & "يوم للحصول على كود جديد من الوكيل المعتمد ")
   
   
   
End Sub


أدرج مديول  جديد  ( طبعاً هيكون اسمه  Module1  )   احفظ   واقفل  وأعد فتح الملف 

 

مرة أخرى أؤكد أننى أعمل على أفيس 2010  والملف يعمل بدون أخطاء 

 

أرجو من باقى الزملاء  تأكيد أو نفى عمل الكود

 

لكم جميعا كل التحية والتقدير

رابط هذا التعليق
شارك

  • 2 months later...

متأسف أستاذى ابراهيم على تأخر الرد وعدم المتابعة

شاهدت مشاركتك الأخيرة بالصدفة الآن وأنا براجع موضوعاتى

لربما يكون فيه مشاركة ولم أرد عليها كمشاركتك هذه فاعذرنى

أستاذى الفاضل لا أعرف الخطأ عندك لكن أريد التأكيد على النقاط الآتية :

وجود كود الحذف فى حدث المصنف

وجود الكود المحذوف فى الملف كمديول عادى وتحت اسم Module1

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

بعد التأكد من ده كله اعمل تمكين الماكرو  واحفظ الملف ثم أعد فتحه .

تحياتى لحضرتك وأعتذر مرة أخرى لتأخر الرد  شكرا لك

  • Like 1
رابط هذا التعليق
شارك

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