طلب كود لمنع تشغيل ملف اكسل 3 ايام من اول تشغيل

[ماجد القثمي]

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

اخواني عندي فكرة لا ادري هل يمكن ان تطبق ،واطلب العون منكم

لدي ملف اكسل به برنامج ادخال معلومات وبحث وتعديل خاص بمجال معين

اريد ان اعرضه للبيع على مجموعه زبائن

الطلب الاول:

اريد ان اعطي الزبون امكانيه تجربه البرنامج لمدة 3 ايام مثلا من اول ما يفتح الملف ع كمبيوتره

وبعد 3 ايام لا يفتح الملف ويعطي رساله(انتهت فترة التجربه اذا اردت شراء البرنامج تواصل مع المالك)

الطلب الثاني:

اريد كود لاغلاق البرنامج بعد سنه من اول تشغيل واعطاء رساله ان اشتراكك قد انتهى لتجديد الاشتراك تواصل مع المالك مثلا.

ولو في امكانيه يعطي الزبون تنبيه قبل انتهاء اشتراكه باسبوع انه تبقى اسبوع على انتهاء الاشتراك اذا رغبت فالتجديد تواصل مع المالك

هذه الفكرة اتمنى وصلت بطريقة مفهومه

 

وشكرا

[حمادة عمر]

شاهد اخي الكريم الرابط التالي

 

[ماجد القثمي]

السلام عليكم

شكرا اخ حمادة على الرد وجزاك الله كل خير

ماشالله حلول بخيارات كثيرة

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

وهي بدل من ان يحذف الملف نفسه، ان يعطي رساله للمستخدم وبعدها عند الاغلاق يحفظ ويغلق الملف

لكن واجهني خطاء في الكود

كما هو موضح في الصورة المرفقة..

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

هذا السطر

(If Err.Number = 13 Then

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

=======================

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

سوال اخر لو سمحت:

هل يتاثر كود البرنامج عند تغيير تاريخ الكمبيوتر يوم للخلف بحيث لا يصل ليوم 30 وتطول المدة للمستخدم؟؟؟

===================

حاولت وضع هذا الكود لكن لا يعمل

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

        If Date > Evaluate("InitialDate") + 1 Then

    MsgBox ("Your trial period will finish within 2 days, contact the owner if you like the program (00000)"), vbExclamation, ""

    ElseIf Date > Evaluate("InitialDate") + 2 Then

    MsgBox ("Your trial period will finish within 1 days, contact the owner if you like the program (00000)"), vbExclamation, ""

    ElseIf Date > Evaluate("InitialDate") + 3 Then

    MsgBox ("Your trial period has finished, contact the owner if you like the program (00000)"), vbExclamation, ""

    End If

ThisWorkbook.Save

end sub

تم تعديل فبراير 22, 2018 بواسطه ماجد القثمي