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

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

قام بنشر

السلام عليكم 
لدي مشكلة يأن كود ربط الملف بسريال اللوحة الأم للجهاز وهو من شرح الأستاذ / عماد غازي 
والملف يعمل بكفاءة على ملفات الاكسل بامتداد .xlsm ولا يعمل على الملف بامتداد .xlsb  فهل هذه المشكلة لها حل والكود لابد من وضع سريال اللوحة الأم لدى المستخدم 
والكود المستخدم هو التالي بشرط لابد من وضع سريال اللوحة الأم لدى المستخدم في احدى الأماكن 1 أو 2 أو 3 من strMB  

Private Sub Workbook_Open()
    Dim strMB As String
        'Put Your MotherBoard Serial
    strMB1 = "HP ProDesk 490 G1 MT, FF004080-EE39-11E3-BFF8-A0D3C13F35B2"
    strMB2 = "HP Compaq 8500 Elite SFF PC, BFDEF800-AF9A-11E0-0000-2C27D742989F"
    strMB3 = "HP Compaq 8500 Elite SFF PC, BFDEF800-AF9A-11E0-0000-2C27D742989F"
    Select Case MBSerialNumber
Case strMB1
GoTo 1
Case strMB2
GoTo 1
Case strMB3
GoTo 1
Case Else
            MsgBox ("Data Security Failure. This Workbook Will Close")
        ActiveWorkbook.Save
        ActiveWorkbook.Close
End Select
1
End Sub

مرفق ملف تعرف من خلاله معلومات عن جهازك بالاكسل ومن ضمن المعلومات سريال اللوحة الأم  نرجو الافادة لو أمكن لأن الملف حجمه كبير وإذا تم حفظه بامتداد  xlsm  سيأخذ حجم أكبر  ... ولكم جزيل الشكر 

 سريال اللوحة الأم.xlsm

قام بنشر

الكود يعمل بصورة طبيعية جدا على ملف xlsb 

رجاء توضيح ما يحدث معك ورقم الخطأ وسطر الخطأ في الكود 

قام بنشر

أستاذ / محمد 

الخطأ عند حفظ الملف بامتداد  xlsb  أو أى ملف xlsb  محفوظ مسبقا ووبنفس الكود بالطبع وسريال اللوحة الأم للجهاز صحيح الملف يتم غلقه وانتحاره دائما وهذا يعني أنه فيه خطأ ولا يتعرف على السريال بالرغم من أن نفس الكود يعمل عندي على الملف بامتداد .xlsm    فإن أمكن لو تكرمت ترفع ملف يعمل عليه الكود بامتداد  xlsb  ولك جزيل الشكر 

قام بنشر

ملفك المرفق

تم إضافة كود فتح المصنف المذكور في مشاركتك الأولى 

وتم حفظ الملف بامتداد xlsb 

وتم إغلاق الملف وفتحه فظهرت الرسالة وتم إغلاق الملف حسب الكود 

قام بنشر

أستاذ / محمد 

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

  • أفضل إجابة
قام بنشر

لا أدري أين المشكلة عندك

ولكن

إذا كنت تريد تطبيق ذلك على ملف آخر بامتداد xlsb

أولا تفتح شاشة الفيجوال بيسك داخل اكسل

ثم تضيف موديول جديد وتلصق فيه الكود الذي يتحقق من رقم الماذربورد

Function MBSerialNumber(Optional strComputer As String = ".") As String
Dim v, vName, vUUID
With GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
For Each v In .ExecQuery("SELECT * FROM Win32_ComputerSystemProduct", , 48)
vName = v.Name: vUUID = v.UUID
Next v
End With
MBSerialNumber = vName & ", " & vUUID
End Function

ثم تضغط دبل كلك على thisworkbook وتلصق هذا الكود في حدث عند فتح الملف

Private Sub Workbook_Open()
Dim strMB1 As String, strMB2 As String, strMB3 As String
'Put Your MotherBoard Serial
strMB1 = "HP ProDesk 490 G1 MT, FF004080-EE39-11E3-BFF8-A0D3C13F35B2"
strMB2 = "HP Compaq 8500 Elite SFF PC, BFDEF800-AF9A-11E0-0000-2C27D742989F"
strMB3 = "HP Compaq 8500 Elite SFF PC, BFDEF800-AF9A-11E0-0000-2C27D742989F"
Select Case MBSerialNumber
Case strMB1, strMB2, strMB3
Exit Sub
Case Else
MsgBox ("Data Security Failure. This Workbook Will Close")
ActiveWorkbook.Close 1
End Select
End Sub

ثم تقوم بحفظ التغييرات وتغلق وتفتح الملف مرة أخرى

بالتوفيق

  • Like 3
  • Thanks 1
قام بنشر

أستاذ / محمد 

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

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

قام بنشر

أخي الفاضل

في حدث عند فتح المصنف راجع هذا السطر

Select Case MBSerialNumber

وهو لاختبار حالات المتغير MBSerialNumber الذي تنتجه الدالة المعرفة MBSerialNumber الموجودة في الموديول المنفصل

فإذا كانت MBSerialNumber مثل واحدة من strMB1, strMB2, strMB3 لا يفعل شيئا ويستمر في فتح المصنف

وإذا كانت غير ذلك يغلق المصنف مع حفظ التغييرات

بالتوفيق

  • 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