ناصراا

السلام عليكم توليفتي للحماية اقدمها لمن رغب بها ففي رايي أنها تكفي للمبتدئين ومن لم يتقصد كسر البرنامج استفدت من الاساتذة في هذا الصرح فلهم الفضل جميعا وأخص الأستاذ ياسر والاستاذ ابو تراب --- تقول التوليفة : ان لم يكن البرنامج مخصص لك فلن يبقى عندك - اجبار المستخدم على تقليل الماكرو - فحص البارتشن C (رقم الهارد ديسك كما يشاع ) - ان لم يتوافق سيحذف البرنامج وإن توافق سيستمر بالتشغيل الطبيعي أرجوا فك الضغط ثم التجربة على الملف غير المضغوط ----------- ملاحظة : لا يحذف من الملف المضغوط لو جربنا عليه وإنما يغلق ذاتيا فقط -------- كلمة سر الفي بي : 1 --------- حاولت أن اربط رقم الهارد ديسك في تكست يختفي في جهاز المستخدم نفسه ثم يقدم له البرنامج بصيغة exe يحوي التكست والأكسل --------- أرجوا أن يستفيد أحد من هذه التوليفة وأن يعلق عليها اساتذتي الكرام في حفظ الله برنامج.rar

جزاك الله خيرا استاذي الكريم على الأقل حماية من المتطفلين الهواة وممن لا يعرف هذه الأمور أو لا يرغب بها صدقا صنعت برنامج بالـvb.net وشفرته وكسر فما بالك بالاكسل شرفتني بمتابعتك أخي ياسر اقترح عليك ان تحفظه في سجل النظام registry بعد تشفير المفتاح و عندها لن تحتاج ان تتعامل مع الملف النصي. كلك خير وبركة أخي الكريم معطاء بلا حدود ان وجدت وقتا فأتمنى أن تدرج مثالا او رابطا لهذه الطريقة شاكرا ومقدرا جهودك استاذي الكريم

بيض الله وجهك وجزاك الله خير الجزاء

IFERROR قد تفي بالغرض اخي الكريم

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

شكرا لك استاذي ابو تراب ممتاز جدا وقام on error بنفس الدور استخدمت الكود كالتالي ليجلب أول سطر فقط فلا احتاج المزيد لكن سؤالي تكرما ما معنى جملة (Input As #1 ) فلم أفهمها Sub btnReadTextFile() Dim myFile As String, text As String, textline As String myFile = "d:\myData\prices.txt" On Error GoTo ErrHandler: Open myFile For Input As #1 Line Input #1, textline text = textline Close #1 Range("B3").Value = textline Exit Sub ErrHandler: MsgBox "لم يتم العثور على الملف ", vbCritical + vbOKOnly, "فتح ملف" End Sub

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

السلام عليكم اساتذتي الكرام اعتذر منكم فقد كثرت طلباتي اين الخطأ في هذا الكود تكرما Dim st As Integer Try st = GetFileContents("C:\111.txt") Catch MsgBox "تنبيه ! لا يوجد ملف " EndTry

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

جزاك الله خيرا أليس هو نفس الكود في أول اسطر هذا الموضوع (أول كود في الموضوع) فعلا جربته سابقا ولم ينجح

حبيبي هو نفس الملف مرفقا في المشاركة رقم 3 أعلاه وهو نفس الكود في الصورة ايضا في نفس المشاركة الملف وضعت عليه الكود << فيفترض ان يعطيك رسالة تنبيه أنك لا تملك تصريح ثم يغلق الملف

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

اعذرني اعذرني استاذي سببت لك تشويش الهدف هو جعل الملف لا يفتح في جهاز آخر استعنت بالكود أعلاه لكنه لم ينجح مع بعض الأجهزة توقعت في البداية ان المشكلة من اصدارات اوفيس المختلفة جربت وجربت أثناء حوارنا فوجدت ان الاصدارات ليست هي المشكلة تحديدا المحصلة أن الكود يعمل على بعض الاجهزة فقط ولا ادري اين الخلل وهدف الموضوع اني اريد حماية الملف لجهاز واحد فقط (لمن لديه طريقة مختلفة) ارجوا أن الصورة واضحة الآن اكرر اعتذاري واعتزازي بمداخلاتك ومحاولة مساعدتي لك في القلب كل ود واحترام

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

نعم استاذي الكريم وأيضا جربته على اكسيل 7 في كذا جهاز ويندوز 7 وXp بعضها يعمل ويعضها لا يعمل الغريب اكسيل 7 على ويندوز 7 في جهازين مختلفين احدهما اشتغل والآخر لم يشتغل

شكرا لعودتك مرة أخرى حبيبي الغالي الكود يعمل عندي بكفائه (أي أن الملف لا يفتح في جهازي لاختلاف السيريال ) لكنه يفتح في جهاز آخر لا يطابق نفس السيريال ايضا في الملف المرفق في المشاركة أعلاه نفس الملف لا يفتح في جهازي ويفتح في جهاز آخر علما أن السيريال المطلوب هو (000000000) تكرما انظر الكود في الصورة في المشاركة السابقة أرجوا المساعدة وحل المشكلة

استاذي الفاضل ياسر شكرا لك جربت التضمين ولم ينجح في تشغيل الكود في جهاز العميل -- وضعت كود الحماية وضمنت المكتبة كما تعلمت منك وحفظته يفترض الملف المرفق لن يشتغل في جهازك أو اي جهاز آخر لأنه يطلب رقم السيريال (0000000) وطبقت الخطوات التالية في الصورة 2222.rar

السلام عليكم الاخوة الكرام الكود التالي يعمل في جهازي ولا يعمل لدى العملاء حيث توقعت ان السبب هو اصدارات الافيس المختلفة فهل من حل لحماية البرنامج فلا يشتغل على جهاز آخر او اضافة للكود فيشتغل على نسخ الاكسل المختلفة Private Sub Workbook_Open() If Hex(CreateObject("Scripting.FileSystemObject").Drives.Item("C:").SerialNumber) <> "0000000000" Then MsgBox "تنبيه ! لا يوجد تصريح لتشغيل البرنامج ", vbCritical, "" ThisWorkbook.Close savechanges = True End If End Sub ايضا جربت اضافة كود الاستاذ محمد طاهر http://www.officena.net/ib/index.php?showtopic=25&st=0&p=46&fromsearch=1&#entry46 للتحكم في مستوى الامان ودمجت الكودين ولم يعمل ايضا مع الاجهزة الاخرى Private Sub Workbook_Open() Application.SendKeys "{f10}" Application.SendKeys "tms" Application.SendKeys "{tab}" Application.SendKeys "l" Application.SendKeys "{ENTER}" If Hex(CreateObject("Scripting.FileSystemObject").Drives.Item("C:").SerialNumber) <> "0000000000" Then MsgBox "تنبيه ! لا يوجد تصريح لتشغيل البرنامج ", vbCritical, "" ThisWorkbook.Close savechanges = True End If End Sub فهل من حل رحم الله والديكم

جزاك الله خيرا استاذي الكريم وشكرا لك لكن النسخة النهائية ستذهب لعدة مستخدمين وعدة اجهزة وهنا يجب ان نقوم بالخطوات مع كل مستخدم وهذا أمر مرهق فهل من حل آخر ؟؟ شاكرا ومقدرا

السلام عليكم اساتذتي الكرام اسعد الله اوقاتكم بالمسرات لدي سؤال تكرما منكم هل يمكن تغيير لون مثلث التعليق الأحمر إلى لون آخر أو حتى اخفاء المثلث تماما مع بقاء التعليقات في مكانها

السلام عليكم اساتذتي الكرام هل من رأي أو طريقة لحل المشكلة ؟

وعليكم السلام ورحمة الله وبركاته جزاك الله خير الجزاء استاذذي الكريم ابو عيد الكود رائع جدا أوقفت الأزرار وغيرت النسبة المئوية الى رقم عبر تغيير السطر للتالي xlConditionValueNumber لكن المشكلة لازالت قائمة فهل تقترح حلا آخر اليك الفيديو بعد تطبيق الكود التالي وربطه بمصدر البيانات التنسيق الشرطي يتغير تلقائيا مع الارقام وهذا ابداع منك حفظك الله http://www.fowzan.net/555.rar Private Sub ToggleButton1_Click() 'If ToggleButton1.Value = False Then 'ToggleButton1.Caption = "ãÓÍ ÇáÊäÓíÞ1" Application.ScreenUpdating = False Range("c:g").FormatConditions.AddIconSetCondition Range("c:g").FormatConditions(Range("c:g").FormatConditions.Count).SetFirstPriority With Range("c:g").FormatConditions(1) .ReverseOrder = True .ShowIconOnly = True .IconSet = ActiveWorkbook.IconSets(xl3TrafficLights1) End With With Range("c:g").FormatConditions(1).IconCriteria(2) .Type = xlConditionValueNumber .Value = 0 .Operator = 7 End With With Range("c:g").FormatConditions(1).IconCriteria(3) .Type = xlConditionValueNumber .Value = 1 .Operator = 7 End With 'Else 'ToggleButton1.Caption = "ÊØÈíÞ ÇáÊäÓíÞ1" 'Range("c:g").FormatConditions.Delete 'End If Application.ScreenUpdating = True End Sub

استاذي الكريم أبو عيد جزاك الله خيرا على جهدك خطر في بالي ما تفضلت به واليك الفيديو التالي يؤكد أن ان السبب ليس في تكرار أو كثرة التنسيقات شاكرا ومقدرا http://www.fowzan.net/444.rar

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

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