TWO PASSWORDS WITHLINKING FILE

[ASHRAFASAL]

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

الأخوة الأعزاء .. السلام عليكم ورحمة الله وبركاته.

الكود يعمل بشكل كامل وصحيح عندما لا يكون مرتبط مع ملف آخر(أعتقد أن المشكلة تتولد عند اغلاق الملف).

أرجو المساعدة وعمل اللازم.

طلب آخر لو تكرمتم .(.كما ترون أنني يجب علي ان أدخل كلمتي المرور ).وما آمل أليه أن يعدل الكود ليعرض على كل مستخدم أن يدخل كلمة المرور هو ..على أن تظل كلمة المرور الثانية ثابتة اتحكم بها ومن خلالها أستطيع فتح الملف

أكرر ثانية شكري وامتناني وجزاكم الله خيرا.وجعله في موازين حسناتكم

[code]'ÈÓã Çááå ÇáÑÍãä ÇáÑÍíã


Option Explicit
Const ApplicationTitle1 = "OFFICENA"

Const ApplicationTitle2 = "ÃæÝíÓäÇ"
Private BinNormalExit As Boolean
Private Sub Workbook_Beforeclose(Cansel As Boolean)

If BinNormalExit = True Then
   MsgBox "remmber to back up your your work " & "this application", vbExclamation, ApplicationTitle1
  
End If

End Sub



Private Sub Workbook_Open()


  Dim StrCorrectPassword1 As String
  Dim StrCorrectPassword2 As String
  Dim StrUserPassword As String

  Dim IntAttempts As Integer
  
 StrCorrectPassword1 = "ESSAM"

 StrCorrectPassword2 = "AHMED"

  StrUserPassword = InputBox("Enter Password", ApplicationTitle1)
  IntAttempts = 1
  
  Do Until StrUserPassword = StrCorrectPassword1 _
        Or StrUserPassword = StrCorrectPassword2 Or IntAttempts = 3
  
  
  StrUserPassword = InputBox("Invalid Password" & "try again.", ApplicationTitle2)
  IntAttempts = IntAttempts + 1
  Loop
  

 If StrUserPassword = StrCorrectPassword1 Then
    MsgBox "Password Accepted", vbInformation, ApplicationTitle2
    BinNormalExit = True
   Else

 If StrUserPassword = StrCorrectPassword2 Then
    MsgBox "Password Accepted", vbInformation, ApplicationTitle2
    BinNormalExit = True
   Else


    MsgBox "Invaled Password.Application will be termenated", vbCritical, ApplicationTitle2
    
    BinNormalExit = False
    
   
  Workbooks.Close
   
 End If
End If
 End Sub

[محمد طاهر عرفه]

السلام عليكم

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

بالنسبة للسؤال

فالجزء الاول منه غير واضح فقد جربت الكود مع وجود رابط ـ فما المشكلة ؟؟ رجاء التوضيح

الجزء الثاني ، اذا غير المستخدم كلمة السر فسيضطرنا هذا الي تخزينها ،ـ و بالتالي سيمكنه العثور عليها بالبحث ، و ربما الحل فى تشفيرها قبل التخزين فهل هذا ما تريد ؟؟

[ASHRAFASAL]

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

..وعليكم السلام ورحمة الله وبركاته

أولا وقبل كل شئ أعتذر عن عدم التزامي بقواعد المشاركة

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

نعم أو لا "..يظل كتاب العمل مفتوحا وكأنه غير محمي بكلمة سر ويعطيك رسالة

Run -time error "1004:"

Mothod " close" of object "workbooks" failed

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

Option Explicit
Const ApplicationTitle1 = "Officena"
Const ApplicationTitle2 = "OFFICENA"
Private BinNormalExit As Boolean
Private Sub Workbook_Beforeclose(Cansel As Boolean)
  If BinNormalExit = True Then
     MsgBox "Remmber to back up yourwork " _
     & "this application", vbExclamation, ApplicationTitle1
   End If
End Sub
Private Sub Workbook_Open()
   Dim StrCorrectPassword1 As String
   Dim StrCorrectPassword2 As String
   Dim StrUserPassword As String
   Dim IntAttempts As Integer
   Dim x As String
   
   StrCorrectPassword1 = "ESSAM"
   StrCorrectPassword2 = "AHMED"
   StrUserPassword = InputBox("Enter Password", _
   ApplicationTitle1)
   IntAttempts = 1
 Do Until StrUserPassword = StrCorrectPassword1 _
        Or StrUserPassword = StrCorrectPassword2 _
        Or IntAttempts = 3
    StrUserPassword = InputBox("Invalid Password" _
   & "try again.", ApplicationTitle2)
   IntAttempts = IntAttempts + 1
Loop
If StrUserPassword = StrCorrectPassword1 Then
   MsgBox "Password Accepted", vbInformation _
   , ApplicationTitle2
   BinNormalExit = True
  Else

If StrUserPassword = StrCorrectPassword2 Then
   MsgBox "Password Accepted", vbInformation _
   , ApplicationTitle2
    BinNormalExit = True
  Else
    x = MsgBox("Invaled Password.Application will be termenated" _
    , vbQuestion Or vbYesNo, ApplicationTitle2)
   If x = vbNo Then
      BinNormalExit = False
      Workbooks.Close
    Else
      BinNormalExit = False
      
      
      Workbooks.Close
    End If
  End If
 End If

 End Sub

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

أكرر اعتذاري ثانية

واكرر دعائي أن يجعله الله في ميزان حسناتكم

[محمد طاهر عرفه]

لم أراجع الكود الجديد بعد

و لكن يوجد اقتراح بان نضيف الحفظ مباشرة الي الكود ، فلا يسأل

ثانيا : لا يمكن بأي حال من الاحوال الكتابة فى الكود كناتج للتفاعل مع المستخدم

لذا ان كان هناك تخزين فأبسط الحلول المقترحة أن سيكون فى خلية

و لكن ليس فى الكود

مع تحياتي

[محمد طاهر عرفه]

و بالنسبة للحفظ فعدل كود قبل الاغلاق الي ما يلي ( اضافة سطر )

Private Sub Workbook_Beforeclose(Cansel As Boolean)
 ActiveWorkbook.Save
 If BinNormalExit = True Then
    MsgBox "Remmber to back up yourwork " _
    & "this application", vbExclamation, ApplicationTitle1
  End If
End Sub

[ASHRAFASAL]

السلام عليكم ورحمة الله وبركاته

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

ربنا يغلق لك أبواب جهنم .. ويفتح لك أبواب الجنة.

أرجو مراجعة الكود للمرة النهائية لتقدمه للزملاء مشاركة مني

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

' In the name of ALLAH

Option Explicit

Const ApplicationTitle1 = "Officena"

Const ApplicationTitle2 = "OFFICENA"

Private BinNormalExit As Boolean

Private Sub Workbook_Beforeclose(Cansel As Boolean)

ActiveWorkbook.Save

If BinNormalExit = True Then

MsgBox "Remmber to back up yourwork " _

& "this application", vbExclamation, ApplicationTitle1

End If

End Sub

Private Sub Workbook_Open()

Dim StrCorrectPassword1 As String

Dim StrCorrectPassword2 As String

Dim StrUserPassword As String

Dim IntAttempts As Integer

Dim x As String

StrCorrectPassword1 = "ESSAM"

StrCorrectPassword2 = "AHMED"

StrUserPassword = InputBox("Enter Password", _

ApplicationTitle1)

IntAttempts = 1

Do Until StrUserPassword = StrCorrectPassword1 _

Or StrUserPassword = StrCorrectPassword2 _

Or IntAttempts = 3

StrUserPassword = InputBox("Invalid Password" _

& "try again.", ApplicationTitle2)

IntAttempts = IntAttempts + 1

Loop

If StrUserPassword = StrCorrectPassword1 Then

MsgBox "Password Accepted", vbInformation _

, ApplicationTitle2

BinNormalExit = True

Else

If StrUserPassword = StrCorrectPassword2 Then

MsgBox "Password Accepted", vbInformation _

, ApplicationTitle2

BinNormalExit = True

Else

x = MsgBox("Invaled Password.Application will be termenated" _

, vbQuestion Or vbYesNo, ApplicationTitle2)

If x = vbNo Then

BinNormalExit = False

ActiveWorkbook.Save

Workbooks.Close

Else

BinNormalExit = False

ActiveWorkbook.Save

Workbooks.Close

End If

End If

End If

End Sub

[ASHRAFASAL]

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

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

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

ألا وهي عندما تفتح ملفا ما (أي ملف أكسيل) تم تصغر الشاشة MIN ..ثم تحاول فتح الملف المعني "المحمي"

وعندما يسألك عن كلمة السر..لاتجيب بنعم أو لا وانما تضغط على زر الالغاء الأحمر "X" الموجود في أقصى زاوية الشاشة..

(خاصة عندما يعطيك اكسيل رسالته وتجيب ب.."X" تجد الملف فتح لك وكأنه غير محمي بالمرة

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

[ASHRAFASAL]

السلام عليكم ورحمة الله وبركاته

انتظرت مثلما وجهني المهندس محمد طاهر

لكنني وجدت مشاركتي قد ألغيت ..ألا يوجد لها حل

أرجو الرد

[ASHRAFASAL]

السلام عليكم ورحمة الله وبركاته

انتظرت مثلما وجهني المهندس محمد طاهر

لكنني وجدت مشاركتي قد ألغيت ..ألا يوجد لها حل

أرجو الرد