ناصراا

السلام عليكم 

توليفتي للحماية اقدمها لمن رغب بها 

ففي رايي أنها تكفي للمبتدئين ومن لم يتقصد كسر البرنامج 

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

وأخص الأستاذ ياسر والاستاذ ابو تراب

---

تقول التوليفة :

ان لم يكن البرنامج  مخصص لك فلن يبقى عندك 

- اجبار المستخدم على تقليل الماكرو 

- فحص البارتشن C  (رقم الهارد ديسك كما يشاع )

- ان لم يتوافق سيحذف البرنامج 

وإن توافق سيستمر بالتشغيل الطبيعي 

أرجوا فك الضغط ثم  التجربة على الملف غير المضغوط

-----------

ملاحظة : لا يحذف من الملف المضغوط لو جربنا عليه وإنما يغلق ذاتيا فقط

--------

كلمة سر الفي بي : 1

---------

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

ثم يقدم له البرنامج بصيغة exe يحوي التكست والأكسل 

---------

أرجوا أن يستفيد أحد من هذه التوليفة 

وأن يعلق عليها اساتذتي الكرام 

في حفظ الله 

برنامج.rar

 

أخي ناصر سبق وأن أخبرتك أن الحماية في الإكسيل قد تكون منعدمة

بالنسبة لباسورد VBA يمكن بكل سهولة التغلب عليه

 

جزاك الله خيرا استاذي الكريم 

على الأقل حماية من المتطفلين الهواة 

وممن لا يعرف هذه الأمور أو لا يرغب بها 

صدقا صنعت برنامج بالـvb.net

وشفرته وكسر فما بالك بالاكسل 

شرفتني بمتابعتك أخي ياسر 

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

 

Password.jpg

 

اخي ناصر بالنسبة ل:

 وسؤالي عن التكست لأضع فيه رقم الهارد في مكان ما في الجهاز 

 

 

اقترح عليك ان تحفظه في سجل النظام 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

جربت الكود وهو يعمل بدون مشاكل.

 

الذي يبدو انه يفتح مباشرة ابدون تنفيد الكود ذا كانت اعدادات الماكر على الخيار الاول او الثالث  كما في الصورة.

 

جرب اختيار الخيار المحدد في الصورة و بعدها اعد فتح الملف:

 

Macro.jpg

جزاك الله خيرا أخي ابو تراب 

وجدته يعمل 

لكن الاشكالية كانت في فرض خفض الماكرو 

السلام عليكم 

اساتذتي الكرام 

اعتذر منكم فقد كثرت طلباتي 

اين الخطأ في هذا الكود تكرما 

Dim st As Integer
    Try
  st = GetFileContents("C:\111.txt")
                Catch
MsgBox "تنبيه ! لا يوجد ملف "
                EndTry

 

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

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

 

للأسف معي مش شغال 

أنا أضع السيريال 0000 

حتى اجرب ألا يفتح في اجهزة أخرى 

مع ذلك يفتح عادي في بعضها 

اضفت كود الاستاذ محمد طاهر (أعلاه )

أعطى نتائج أفضل 

لكن لا يزال غير جيد ولا يمكن الاعتماد عليه اطلاقا (في بعض الأجهزة يشتغل الملف وكأن لا وجود للكود أصلا )

فلا ادري ما الحل 

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

أليس هو نفس الكود في أول اسطر هذا الموضوع (أول كود في الموضوع)

فعلا جربته سابقا ولم ينجح 

 

لما لم ينجح كود الربط بسيريال الهادر ديسك؟

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

 

حبيبي 

هو نفس الملف مرفقا 

في المشاركة رقم 3 أعلاه 

وهو نفس الكود في الصورة  ايضا في نفس المشاركة 

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

شكرا لك حبيبي 

لم ينجح حتى الآن كود الربط بالهارد 

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

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

أكرر شكري واحترامي لوقتك الثمين الذي بذلته 

 

الهدف هو المشكلة والمشكلة هي الهدف .. أنا كدا تهت منك ومش عارف أحدد مشكلتك لأن مشكلتك هي هدفك وهدفك هو مشكلتك

أرجو التوضيح أكثر لو سمحت يا أخ ناصر .. اعذرني لأني لم أفهم مشكلتك ...!!!

أنا أحاول جاهدا مساعدتك لكن يبدو أن الموضوع متشابك ويحتاج لتدخل من هم أعلم مني

 

اعذرني اعذرني استاذي 

سببت لك تشويش 

الهدف هو جعل الملف لا يفتح في جهاز آخر 

استعنت بالكود أعلاه 

لكنه لم ينجح مع بعض الأجهزة 

توقعت في البداية ان المشكلة من اصدارات اوفيس المختلفة 

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

المحصلة أن الكود يعمل على بعض الاجهزة فقط ولا ادري اين الخلل 

وهدف الموضوع اني اريد حماية الملف لجهاز واحد فقط (لمن لديه طريقة مختلفة)

ارجوا أن الصورة واضحة الآن 

اكرر اعتذاري 

واعتزازي بمداخلاتك ومحاولة مساعدتي 

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

 

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

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

 

نعم استاذي 

بعضها يطلب تمكين الماكرو 

وبعد تمكينه ينفذ الكود ويغلق البرنامج  (لأن السيريال غير صحيح) وبعضها لا يشعر اصلا بوجود الكود 

هل من طريقة أخرى للخروج من هذه الاشكالية 

الهدف : هو عدم تشغيل  الملف في جهاز آخر 

 

قد تكون المشكلة فعلا في إصدارات الأوفيس المختلفة أخي الحبيب .. هل جربت الملف على أكثر من إصدار ؟؟

 

نعم استاذي الكريم 

وأيضا 

جربته على اكسيل 7 في كذا جهاز ويندوز 7 وXp

بعضها يعمل ويعضها لا يعمل 

الغريب 

اكسيل 7 على ويندوز 7 في جهازين مختلفين 

احدهما اشتغل والآخر لم يشتغل 

 

أخي الفاضل الكود مرتبط على ما يبدو بالسيريال الخاص بالهارد ديسك ومن ثم يفتح عندك أما عند العميل فلن يفتح لأن السيريال الخاص بالهارد ديسك التابع له مختلف ...

إذا لابد لكي يفتح أن يتم إدخال السيريال الخاص بهارد العميل

 

شكرا لعودتك مرة أخرى 

حبيبي الغالي

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

في الملف المرفق في المشاركة أعلاه 

نفس الملف لا يفتح في جهازي ويفتح في جهاز آخر 

علما أن السيريال  المطلوب هو (000000000)

تكرما انظر الكود في الصورة في المشاركة السابقة 

أرجوا المساعدة وحل المشكلة 

 

أستاذ ناصر

لابد لكي يعمل الكود أن تقوم بإضافة المكتبة الخاصة من خلال محرر الأكود القائمة أدوات Tools انقر على References ثم ابحث عن المكتبة Microsoft Scripting Runtime وعلم عليها علامة صح واضغط أوك وجرب ...

 

استاذي الفاضل ياسر 

شكرا لك 

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

--

وضعت كود الحماية 

وضمنت المكتبة كما تعلمت منك 

وحفظته 

يفترض الملف المرفق 

لن يشتغل في جهازك 

أو اي جهاز آخر لأنه يطلب رقم السيريال  (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