كود عند تفعيل الماكرو يطلب باسورد ( مساعده )

[محمد عبد الناصر]

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

عايز كود عند تفعيل الماكرو فى اكسيل يطلب منى باسورد يعنى اول لما افعل الماكرو يطلب الباسورد

[محمد عبد الناصر]

؟؟؟؟؟؟؟؟؟؟؟

 

 

[عبد العزيز البسكري]

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

حاول إضافة هذيْن السّطريْن في بداية الماكرو ..أي ماكرو .. بحيث 123 هي كلمة المرور ..لعل و عسى تضبط معك .. لكن لا بد من حماية محرر الأكواد بكلمة مرور لمنع التحايل بوضع ماكرو غير محمي يؤدي نفس مهمة الماكرو المحمي .. لاحظ الملفيْن أتمنى أن يكون هو طلبك .. خالص احتراماتي 

كلمة المرور للماكرو.rar

[KHMB]

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

شكرا اخي الفاضل عبدالعزيز

وهذا حل آخر بواسطة الفورم لعل احد يستفاد منة

كلمة مرور لماكرو.rar

[عبد العزيز البسكري]

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

حل مميّز من أستاذنا المميّز KHMB .. بارك الله فيك و زادها بميزان حسناتك ..

[محمد عبد الناصر]

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

[محمد عبد الناصر]

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

 

تم تعديل سبتمبر 12, 2015 بواسطه جيل التابعين

[جعفر الطريبق]

الموضوع غير واضح ... هل تقصد شيئ من هدا القبيل

هدا الكود في ال  ThisWorkbook Module  يطلب من المستخدم الباسوورد اللي هو "123" عندما يفتح الملف و الماكرو مفعل    ... لو الباسوورد غلط الملف يغلق نفسه

Private Sub Workbook_Open()
    Application.EnableCancelKey = xlDisabled
    If InputBox("Enter Password") <> "123" Then
        MsgBox "Wrong Password" & vbCr & vbCr & "Workbook Closing Now !", vbExclamation
        Application.EnableCancelKey = xlInterrupt
        Me.Close True
    End If
End Sub

 

[محمد عبد الناصر]

تمام حضرتك انا عايزو يطلب الباسورد مره وحده بسسسسسسسسسس مره وحده بسسسسس لما الماكرو يتفعل وبعد كده يفتح عادى بحيث لو اخدت الملف كوبى الماكرو مش هايكون شغال فى رساله بتجيلى انى افعل الماكرو اول بقى مدوس عليها فى الملف الجديد يطلب باسورد مره وحده بس

[جعفر الطريبق]

و الله ما فهمت ... لو أحد فهم يشرح لي

هل هدا ما تقصده:

1- أول مرة يتم فتح الملف يطلب الباسوورد .. بعدها لا يطلب الباسوورد

2- في حالة أخد كوبي من الملف فان هدا الملف الجديد *يعني الكوبي*  يطلب الباسوورد عند فتحه لأول مرة فقط  ثم بعدها لا يطلب الباسوورد

 

ثم هل الكوبي سيتم فتحه في نفس الحاسوب أو في حاسوب أخر

 

تم تعديل سبتمبر 12, 2015 بواسطه جعفر الطريبق

[عبد العزيز البسكري]

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

للأسف أستاذنا جعفر الطريبق .. نحن الثلاثة لم نتمكن من فهم المطلوب بالضبط

                              خالص احتراماتي

[محمد عبد الناصر]

ايوه حضرتك كده بالظبط ياريت لو ينفع تتعمل اكون شاكر لحضرتك جداااااااااااااااااااااااااا بس الملف هايتفتح على جهاز تانى

تم تعديل سبتمبر 13, 2015 بواسطه جيل التابعين

[محمد عبد الناصر]

??????????

[جعفر الطريبق]

الكود التالي يطلب من المستخدم ادخال الباسوورد "123" عند افتتاح الملف لأول مرة على الجهاز  ..لو الباسورد غلط فالملف يغلق نفسه تلقائيا ...  لو المستخدم عمل كوبي للملف و فتح الكوبي على جهاز أخر فالكود يشتغل من جديد و يتم طلب الباسوورد في المرة الأولى فقط

طبعا لو الماكروس غير شغالة ( Macros Disabled ) عند المستخدم فان الكود لن يعمل

لكي لا يستطيع المستخدم رؤية الباسورد ينصح حماية ال VBAProject

أضف الكود التالي الى  ThisWorkbook Module :

Private Sub Workbook_Open()
    Dim bool As Boolean
    On Error Resume Next
        bool = [DriveSN] = GetDriveSerialNumber
    On Error GoTo 0
    Application.EnableCancelKey = xlDisabled
    If bool = False Then
        If InputBox("Enter the Password") <> "123" Then
            MsgBox "Wrong Password ..." & vbCrLf & "Workbook Closing !", vbExclamation
            Application.EnableCancelKey = xlInterrupt
            Me.Close False
        Else
            Names.Add "DriveSN", GetDriveSerialNumber, False: Me.Save
        End If
    End If
    Application.EnableCancelKey = xlInterrupt
End Sub

Private Function GetDriveSerialNumber() As Long
    Dim oFso As Object
    Set oFso = CreateObject("Scripting.FileSystemObject")
    With oFso.GetDrive(oFso.GetDriveName(Application.Path))
        GetDriveSerialNumber = Abs(.SerialNumber)
    End With
    Set oFso = Nothing
End Function

 

تم تعديل سبتمبر 13, 2015 بواسطه جعفر الطريبق

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

بسم الله ما شاء الله كود رائع ومفيد جداً

بارك الله فيك أخي جعفر ولا حرمنا الله منك

واصل بلا فواااااااااااااااااااصل ..

[محمد عبد الناصر]

هو اشتغل تمام مع الملف اول مره لما فعلت الماكرو وبعد كده مطلبش الباسورد بس لما اخدت الملف كوبى وفعلت الماكرو مطلبش باسورد

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

أخي الكريم

أكيد أخذت الملف كوبي وعملت لصق على نفس الجهاز .. لكن لوجهاز تاني تم عمل النسخ للملف واللصق أكيد هيسألك لأن الكود بيعتمد على سيريال الهارد وسيريال الهارد بيختلف من جهاز لآخر ..

[محمد عبد الناصر]

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

تم تعديل سبتمبر 14, 2015 بواسطه جيل التابعين

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

دا وارد مع الكود لو عملت كوبي للملف في بارتشن تاني غير البارتشن الموجود

يعني لو الملف موجود على البارتشن C لو أخذت منه نسخة على البارتشن D أو أي بارتشن آخر سيقوم بنفس المطلوب

 

غير السطر التالي

With oFso.GetDrive(oFso.GetDriveName(Application.Path))

إلى السطر التالي

With oFso.GetDrive(oFso.GetDriveName(ThisWorkbook.Path))

بكدا هيكون الملف مرتبط بالبارتشن اللي فيه المصنف

أرجو أن يؤدي الغرض

 

تم تعديل سبتمبر 14, 2015 بواسطه ياسر خليل أبو البراء

[محمد عبد الناصر]

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

اى ملف بعمل منو نسخه الماكرو بيطلب منى التفعيل عايز بقى لما يطلب منى التفعيل يطلب وافعله باسورد مره وحده بس

تم تعديل سبتمبر 14, 2015 بواسطه جيل التابعين

[محمد عبد الناصر]

???

[جعفر الطريبق]

لا أعتقد أنه ممكن التمييز بين الملف الأصلي و النسخة  الكوبي ... و ما يجعل الأمر أكثر صعوبة هو امكانية عمل كوبي لملف الاكسيل بدون فتح الاكسيل أي مباشر عبر ال Shell ... الحل الوحيد الدي يخطر ببالي هو عمل برنامج VBScript  او VB6 يشتغل تلقائيا عند تشغيل الجهاز StartUp و هدا البرنامج وظيفته هي مراقبة حدث ال  File Copy وراء الكواليس بحيث عند عمل كوبي للملف يتم تحديد و تخزين أسماء الملفين الأصلي و النسخة و بالتالي التمييز بينهما .. للأسف هده الفكرة شوية معقدة أكثر من اللازم 

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

أخي الحبيب جعفر

رغم أن الفكرة معقدة كما ذكرت إلا أنني على استعداد أن أصبر شهوراً طوال للوصول إليها كونها فكرة جديدة وممتازة وتفيد في أغراض أخرى

وأنا بإذن الله أثق في الله ثم في قدراتك في الوصول لمثل هذا الحل العبقري

تقبل وافر تقديري واحترامي