رجاء ساعدوني في كيفية التاكد من سيريال نمبر الجهاز للتأكد من الصحة او

[DIAA125]

السلام عليكم

اللي اقصدة بالظبط كالتالي الاستاذ هادي سالم كان عرض قبل كدا كود لمعرفة سيريال نمبر الجهاز وانا هرفقلكم الملف اللي ارفقة قبل ذلك

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

رجاء ساعدوني الفكرة مهمة ومفيدة ومش عارف اذا كانت اتعرضت قبل كدا ولا لا

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

________________________.rar

[هادى محمد المامون سالم]

اللي اقصدة بالظبط كالتالي الاستاذ هادي سالم كان عرض قبل كدا كود لمعرفة سيريال نمبر الجهاز وانا هرفقلكم الملف اللي ارفقة قبل ذلك

بسم الله الرحمن الرحيم

برجاء ارشادى على رابط الموضوع الذى تقصده ليتم دمج الموضوع

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

    Sub Auto_Open()
    Dim fs, d, s, t
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))
    [B2].ClearContents
    [B2] = -d.SerialNumber
    If Sheets("Sheet1").[B2].Value = Sheets("Sheet1").[B2].Value Then
        MsgBox "سيتم فتح الملف"
    Else:
        MsgBox "سيتم اغلاق الملف"
        ThisWorkbook.Save
        Application.Quit
    End If
End Sub

وقد ارفقت لك ملف و لن يعمل معك لان خليه المفارنه فارغه و لكى يعمل بعك اتبع التالى :

افتح الملف سوف تظهر لك رساله بان المقارنه خاطئه و سيتم اغلاف الملف و لكن لاحظ ان رقم الهارد سوف يظهر لك فى الخليه B1 اكتبها عندك , ثم قم بانشاء ملف جديد و انقل رقم الهارد فى الخليه B1 و B2 ثم انسخ الكود السابق و الصقه فى موديول , اقفل الملف ثم اعد فتحه و سوف يفتح معك ان شاء الله

مرفق ملف

السلام عليكم

My_Drive_01.rar

[DIAA125]

السلام عليكم الاخ هادي سالم

برجاء ارشادى على رابط الموضوع الذى تقصده ليتم دمج الموضوع

هذا هو رابط الموضوع

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

جزاك الله الف خير لكن برضوا جزاك الله خير انا مش عايز الصفحة اللي فيها المقارنة تظهر اعمل اية

جزاك الله الف خير

[DIAA125]

السلام عليكم الاخ هادي سالم

رجاء اضافة على هذا الكود بحيث انة بعد التأكد من المقارنة يخفي الشيت الذي يحتوي على المقارنة اذا امكن

جزاكم الله خير

[هادى محمد المامون سالم]

السلام عليكم الاخ هادي سالم

رجاء اضافة على هذا الكود بحيث انة بعد التأكد من المقارنة يخفي الشيت الذي يحتوي على المقارنة اذا امكن

جزاكم الله خير

بسم الله الرحمن الرحيم

جرب الملف المرفق

السلام عليكم

My_Drive_02.rar

[DIAA125]

السلام عليكم الاخ هادي سالم

رجاء اضافة على هذا الكود بحيث انة بعد التأكد من المقارنة يخفي الشيت الذي يحتوي على المقارنة اذا امكن

جزاكم الله خير

بسم الله الرحمن الرحيم

السلام عليكم

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

[هادى محمد المامون سالم]

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

بسم الله الرحمن الرحيم

اليك الكود الذى تريده

Sub Auto_Open()
    Sheets("Sheet1").Visible = xlSheetVeryHidden
    Dim fs, d, s, t
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))
    [B2].ClearContents
    [B2] = -d.SerialNumber
    If Sheets("Sheet1").[B2].Value = Sheets("Sheet1").[B2].Value Then
        MsgBox "سيتم فتح الملف"
    Else:
        MsgBox "سيتم اغلاق الملف"
        ThisWorkbook.Save
        Application.Quit
    End If
End Sub

السلام عليكم

[DIAA125]

جزاك الله خير يا اخ هادي سالم وجعل مثواك الجنة امين يا رب

انا شاكر جداً على ذوقك وسعة صدرك لو امكن ممكن رقم جوالك او اميلك

[هادى محمد المامون سالم]

جزاك الله خير يا اخ هادي سالم وجعل مثواك الجنة امين يا رب

انا شاكر جداً على ذوقك وسعة صدرك لو امكن ممكن رقم جوالك او اميلك

بسم الله الرحمن الرحيم

hs889@hotmail.com

السلام عليكم