ريان أحمد قام بنشر أكتوبر 2, 2011 قام بنشر أكتوبر 2, 2011 السلام عليكم أريد كود يمنع الملف من الفتح عندما يستبدل جهاز الكمبيوتر--نقله-
دغيدى قام بنشر أكتوبر 2, 2011 قام بنشر أكتوبر 2, 2011 تفضل أخى ملف من عمل أحد زملاء المنتدى ( نعتذر لعدم تذكر اسمه ) منع فتح الملف إذا تم نقله أو تغيير إسمه ومنع حفظه بإسم جديد منع فتح الملف.rar
ياسر الحافظ قام بنشر أكتوبر 2, 2011 قام بنشر أكتوبر 2, 2011 اخي وصديقي واستاذي " دغيدي " والله انا مشتاق لك ... جزاك الله كل الخير على اعمالك وردودك القيمة وفقك الله ابو الحارث
أبو العاصم قام بنشر أكتوبر 23, 2011 قام بنشر أكتوبر 23, 2011 طب ممكن كود لمنع نسخ الملف يعنى يمنع عمل كوبى وبست لو هناك شرط فى الملف وهو مغلق
الـعيدروس قام بنشر أكتوبر 23, 2011 قام بنشر أكتوبر 23, 2011 السلام عليكم جزاك الله الف خير استاذ دغيدي ولاثراء الموضوع هذا كود اخر اولاً استخدم هذا الكود لقراءة رقم ID الهارد ثم اكتب الايدي في مذكرة رقم الايدي نفسه اذا كانت الحروف كبتل عادة بيكون كبتل مع ارقام هذا الكود Sub code_HARD() With CreateObject("Scripting.FileSystemObject") MsgBox Hex(.Drives.Item("c:").SerialNumber) End With End Sub وبعد حفظ رقم الايدي حط هذا الكود في حدث ThisWorkbook Private Sub Workbook_Open() With CreateObject("Scripting.FileSystemObject") If Hex(.Drives.Item("c:").SerialNumber) = "F0E1D85C" Then MsgBox "تفضل بالدخول" Else: MsgBox "نأسف هذا البرنامج مخصص لجهاز اخر " ThisWorkbook.Close savechanges = True End If End With End Sub استبدل الايدي الذي في الشرط بالايدي المحفوظ من هذا السطر المشار باللون الاحمر If Hex(.Drives.Item("c:").SerialNumber) = "[color=#ff0000]F0E1D85C[/color]" Then الية الكود اذا حاولت استخدام الملف في جهاز اخر لن يفتح لان رقم الايدي غير مطابق والسلام عليكم
MAHMOUD ALI YOUSSEF قام بنشر أكتوبر 23, 2011 قام بنشر أكتوبر 23, 2011 السلام عليكم اكواد قمة في الروعة جزاكم الله كل خير :fff:
zarouki2000 قام بنشر ديسمبر 22, 2012 قام بنشر ديسمبر 22, 2012 الاخ ابو نصار الاخوة الافاضل السلام عليكم ورحمة الله و بركاته الكودر الخاص بربط ملف بالهارد كود رائع حقيقة لم اجده فى اى منتدى اجنبى لكن لى طلب بسيط هل يمكن تعديل الكود بحيث يسمح للملف بالفتح على 5 اجهزة يتم تحديدها من خلال رقم الهارد فى الكود جزاكم الله خيرا
الـعيدروس قام بنشر ديسمبر 22, 2012 قام بنشر ديسمبر 22, 2012 السلام عليكم الاخ الفاضل zarouki2000 بعد إستخراج أرقام الأيدي للأجهزة تحطها في المنغيرات PC Private Sub Workbook_Open() Dim PC1$, PC2$, PC3$, PC4$, PC5$ PC1 = "F0E1D85A" ' رقم الايدي للجهاز 1 PC2 = "F0E1D85B" ' رقم الايدي للجهاز 2 PC3 = "F0E1D85C" ' رقم الايدي للجهاز 3 PC4 = "F0E1D85D" ' رقم الايدي للجهاز 4 PC5 = "F0E1D85E" ' رقم الايدي للجهاز 5 With CreateObject("Scripting.FileSystemObject") If Hex(.Drives.Item("c:").SerialNumber) = PC1 Or Hex(.Drives.Item("c:").SerialNumber) = PC2 _ Or Hex(.Drives.Item("c:").SerialNumber) = PC3 Or Hex(.Drives.Item("c:").SerialNumber) = PC4 _ Or Hex(.Drives.Item("c:").SerialNumber) = PC5 Then MsgBox "تفضل بالدخول" Else: MsgBox "نأسف هذا البرنامج مخصص لجهاز اخر " ThisWorkbook.Close savechanges = True End If End With End Sub جرب الكود واخبرنا بالنتائج
احمد حبيبه قام بنشر ديسمبر 29, 2012 قام بنشر ديسمبر 29, 2012 أخى أبو نصار كود رائع لكن لى طلب بسيط هل يمكن تعديل كود قراءة رقم ID الهارد بحيث يظهر فى خلية ممكن نسخ الكود منها بدلا من ظهوره فى MsgBox
الـعيدروس قام بنشر ديسمبر 29, 2012 قام بنشر ديسمبر 29, 2012 السلام عليكم فرضا الخلية هيا "A1" هكذا Sub code_HARD() On Error Resume Next With CreateObject("Scripting.FileSystemObject") '***************************************** [A1].Text = Hex(.Drives.Item("c:").SerialNumber) '***************************************** End With End Sub
احمد حبيبه قام بنشر ديسمبر 29, 2012 قام بنشر ديسمبر 29, 2012 أخى ابو نصار فعلت ما قلت واستبدلت الكود ولكن الكود لا يظهر فى الخلية الكود.rar
zarouki2000 قام بنشر ديسمبر 29, 2012 قام بنشر ديسمبر 29, 2012 السلام عليكم الاخ الفاضل ابو نصار والله كل الكلام الطيب لن يوفيك حقك فانت بعلمك الذى وهبك الله اياه اصبحت كالمصباح السحرى بالنسبة لى دائما ما اجدك فى المكان و الوقت المناسب تفيض علينا جميعا من علمك الغزير بارك الله فيك و فى علمك و انعم الله عليك برغد العيش و جعل كل ذلك فى ميزان حسناتك اللهم امين و بالغ الشكر طبعا لباقى الاخوة الكرام
الـعيدروس قام بنشر ديسمبر 29, 2012 قام بنشر ديسمبر 29, 2012 السلام عليكم السموحه اخي احمد حبيب بيكون هكذا Sub code_HARD() On Error Resume Next With CreateObject("Scripting.FileSystemObject") '***************************************** [C2].Value = Hex(.Drives.Item("c:").SerialNumber) '***************************************** End With End Sub اخي الفاضل zarouki2000 اشكرك جدا على مرورك العطر وكلامك المشجع تقبلو تحياتي وشكري
احمد حبيبه قام بنشر ديسمبر 29, 2012 قام بنشر ديسمبر 29, 2012 استاذى الغالى أبو نصار تسلم إيدك ودائما سباق لعمل الخير وأحد منارات الإكسل فى هذا المنتدى الرائع ........ بارك الله فيك وزادك من علمه ونفعك به وجعلة الله فى ميزان حسناتك
أبو عبد النور قام بنشر ديسمبر 29, 2012 قام بنشر ديسمبر 29, 2012 السلام عليكم، تفضل أخى ملف من عمل أحد زملاء المنتدى ( نعتذر لعدم تذكر اسمه ) منع فتح الملف إذا تم نقله أو تغيير إسمه ومنع حفظه بإسم جديد قمت يتحميل الملف ولكنني لم اجد به اي كود ؟ هل من الممكن رفعه من جديد للاطلاع عليه والاستفادة ؟ بارك الله فيكم.
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.