محمد عبد الناصر قام بنشر يوليو 27, 2015 قام بنشر يوليو 27, 2015 السلام عليكم ورحمة الله ده عباره عن ملف يقفل نفسو بعد عدد مرات استعمال معين انا عملو بعد مرتين استعمال بيطلب باسوورد عشان تقدر تستخدم البرنامج تانى بيقفل بعد عدد 2 استعمال الباسورد 123456 بس فى صغرى فى الكود مش عارف احلها بمعنى ان انا دلوقتى فتحت الملف وطلب منى الباسورد وانا مش عارفه اقدر انى افتحو عن طريق انى افتح اى ملف اكسيل جديد واكتب فيه اى حاجه واروح للمف الى طالب باسورد واكنسل هبوص الاقى الملف بتاعى مقفلش هيه دى المشلكه ياريت حد يساعدنى فيها والاقى ليها حل وشكرا يا احلى منتدى شكر خااااااااص للأستاذ / ياسر خليل أبو البراء ساعدنى ف مواضيع كتيره جداااااااااا 1.rar
۩◊۩ أبو حنين ۩◊۩ قام بنشر يوليو 27, 2015 قام بنشر يوليو 27, 2015 السلام عليكم هذا الكود الرائع للاخ الجليل ياسر خليل ارجو ان يفى بالغرض Private Sub Workbook_BeforeClose(Cancel As Boolean) If [IK41421] >= 3 Then GoTo 1 [IK41421] = [IK41421] + 1 1: ThisWorkbook.Save End Sub Private Sub Workbook_Open() On Error Resume Next Sheets("Sheet1").Select If [IK41421] >= 3 Then 'MsgBox "لقد استخدمت البرنامج 3 مرات ولن يفتح إلا بكلمة مرور" Dim pwd As String: pwd = "KHMB12345" Cells(Rows.Count, Columns.Count).Activate If Application.InputBox("برجاء إدخال كلمة المرور لفتح الملف مرة اخري حيث فتح الملف ثلاثون مره ولا يمكن فتحه مرة اخرى الا بالرقم السري", "تصريح دخول للملف ", "???") <> pwd Then Sheets("Sheet1").Select Workbook.Update MsgBox " كلمة المرور غير صحيحة ! من فضلك راجع مسئول النظام حيث تم فتح الملف 3 مرات ، ولا يمكن فتحه مرة أخرى إلا بالرقم السري", 0, "عفواً الدخول محظور" ThisWorkbook.Save ThisWorkbook.Application.Quit Else Range("IK41421").Value = 0 Range("A1").Select End If End If End Sub لينك الموضوع http://www.officena.net/ib/index.php?showtopic=58098
محمد عبد الناصر قام بنشر يوليو 27, 2015 الكاتب قام بنشر يوليو 27, 2015 شكرا لتعب حضرتك معايه بس تقريبا حضرتك مقرتش الكلام الى انا كاتبو لحد الاخر الملف بتاعى شغال عادى مفهوش مشكله غير لو الملف مفتوح لوحدو لو انا فتحت مثلا ملف جديد واكتبت فيه اى حاجه وجيت افتح البرنامج بتاعى وطلب الباسورد لو انا كنسلت البرنامج مش بيقفل
ياسر خليل أبو البراء قام بنشر يوليو 27, 2015 قام بنشر يوليو 27, 2015 شااااااااايف السطر ده ThisWorkbook.Application.Quit غيره للسطر ده وجرب وقولي ThisWorkbook.Close 1
محمد عبد الناصر قام بنشر يوليو 28, 2015 الكاتب قام بنشر يوليو 28, 2015 (معدل) والله يا استاذ اسلام خليل شوف كده فوق انا ذاكرك بكل خير هههه عارف ان انت هنا الى بتجيب من الاخر بجد مش عارف اقولك ايه شغل 10/10 ربنا يجعلو فى ميزان حسناتك أخر حاجه وعارف انى برخم عليك واسف جدااا دلوقتى بس البرنامج لما يطلب الباسورد لما بكتبو بيكون ظاهر عادى وانا بكتبو انا عايزو يبان على هيئة نجوم او نقط او اى حاجه عشان محدش يعرف انا بكتب ايه واسف جدااا لتعبك معايه تم تعديل يوليو 28, 2015 بواسطه محمود فؤااد
ياسر خليل أبو البراء قام بنشر يوليو 28, 2015 قام بنشر يوليو 28, 2015 أخي الكريم محمد ارفق ملفك حيث أن المرفق في المشاركة الأولى غير موجود بسبب التحديثات المطلوب صعب إلى حد ما
ياسر خليل أبو البراء قام بنشر يوليو 28, 2015 قام بنشر يوليو 28, 2015 جرب الملف التالي عله يفي بالغرض InputBox Password Mask.rar 1
محمد عبد الناصر قام بنشر يوليو 29, 2015 الكاتب قام بنشر يوليو 29, 2015 لا انا يدوب بفتح الملف بيقولى الباسورد غلط حتى مش بيدينى فرصه اكتب الباسورد
ياسر خليل أبو البراء قام بنشر يوليو 29, 2015 قام بنشر يوليو 29, 2015 هشرح لك الخطوات وإنت نفذها على ملفك بنفسك روح لمحرر الأكواد ومن قايمة Insert قم بإدراج Class Module وسميه PwdInputBox وبعدين الصق الكود التالي فيه '--------------------------------------------------------------------------------------- ' ClassModule : PwdInputBox ' DateTime : 30/07/02 10:30 ' Last modified : 31/07/02 08:49 ' Author : Juan Pablo Gonzalez ' Special thanks to Ivan F Moala for pointing the right way ' Purpose : Shows a standard InputBox but with the cabalitie to have a PasswordChar ' for the text entered. ' Parameters : Prompt As String, required. Text to show on the InputBox ' PasswordChar As String, optional. Character to show as PasswordChar. ' If vbNullString is entered, the text will show up normally. ' Title As String, optional. Title of the InputBox ' Default As String, optional. Default text to show (Will appear with the ' PasswordChar selected. String character to hide the text entered ' XPos As Long, optional. Horizontal distance between the left border of ' the dialog, and the left border of the screen ' YPos As Long, optional. Vertical distance between the upper border of ' the dialog, and the upper border of the sreen ' Outputs : Variant. Is pressed Ok, the text entered. If pressed Cancel, False '--------------------------------------------------------------------------------------- Function PassInputBox(Prompt As String, Optional PasswordChar As String, Optional Title As String, Optional Default As String, Optional XPos As Long, Optional YPos As Long) Dim UF 'Store the VBComponent Dim VUF As Object 'Store the userform object Dim Lb As Object 'Label for the Prompt Dim Tb As Object 'TextBox which holds the password Dim BOk As Object Dim BCancel As Object Dim VBAVisible As Boolean 'Store VBE.Mainwindow visible state to restore it Dim I As Integer 'Default Title is the same as InputBox If Len(Title) = 0 Then Title = Application.Name 'Store the visible property of the VBE mainwindow and hide it to prevent screen flashing VBAVisible = Application.VBE.MainWindow.Visible Application.VBE.MainWindow.Visible = False 'Add temporary Userform Set UF = ThisWorkbook.VBProject.VBComponents.Add(3) 'Add the textbox. If no PasswordChar was supplied, the text will appear normally Set Tb = UF.Designer.Controls.Add("Forms.Textbox.1", "TextBox1") With Tb .PasswordChar = PasswordChar .Left = 4.5 .Top = 69.75 .Width = 254.25 .Height = 15.75 .Value = Default End With 'Add the prompt Set Lb = UF.Designer.Controls.Add("Forms.Label.1") With Lb .Caption = Prompt .WordWrap = True .Left = 6.75 .Top = 6.75 .Width = 198 .Height = 54 End With 'Button OK, it is the default button Set BOk = UF.Designer.Controls.Add("Forms.CommandButton.1", "BOk") With BOk .Caption = "OK" .Left = 209.25 .Top = 4.5 .Width = 49.5 .Height = 18 .Default = True End With 'Button Cancel Set BCancel = UF.Designer.Controls.Add("Forms.CommandButton.1", "BCancel") With BCancel .Caption = "Cancel" .Cancel = True .Left = 209.25 .Top = 27 .Width = 49.5 .Height = 18 End With 'Add code to the Userform module With UF.CodeModule I = .CountOfLines 'MyText is a variant which will hold the answer the user pressed .InsertLines I + 0, "Public MyText as Variant" 'Pressed Cancel, so assign False to MyText .InsertLines I + 1, "Private Sub BCancel_Click()" .InsertLines I + 2, " MyText = False: Me.Hide" .InsertLines I + 3, "End Sub" 'Pressed Ok, so assign the value of TextBox1 to MyText .InsertLines I + 4, "Private Sub BOk_Click()" .InsertLines I + 5, " MyText = TextBox1.Value: Me.Hide" .InsertLines I + 6, "End Sub" 'Closing the form using "X", so assign False to MyText .InsertLines I + 7, "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)" .InsertLines I + 8, " If CloseMode = 0 Then Cancel = True: MyText = False: Me.Hide" .InsertLines I + 9, "End Sub" End With 'Properties for the userform With UF .Properties("Caption") = Title .Properties("Width") = 273 .Properties("Height") = 108.75 'Center on screen or show in a specific position If XPos > 0 Or YPos > 0 Then .Properties("StartUpPosition") = 0 .Properties("Left") = XPos .Properties("Top") = YPos Else .Properties("StartUpPosition") = 1 End If End With 'Include the UF in the Userforms collection Set VUF = VBA.UserForms.Add(UF.Name) 'Show the Userform VUF.Show 'Pass the result to this function PassInputBox = VUF.MyText 'Remove the VBcomponet ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=UF 'Restore the VBE Mainwindow Application.VBE.MainWindow.Visible = VBAVisible End Function وبعدين في موديول المصنف Workbook ضع الكود الخاص بك مع بعض التعديل في الأسطر Private Sub Workbook_BeforeClose(Cancel As Boolean) If [IK41421] >= 2 Then GoTo 1 [IK41421] = [IK41421] + 1 1: ThisWorkbook.Save End Sub Private Sub Workbook_Open() Dim ANS As Variant Dim App As PwdInputBox Set App = New PwdInputBox On Error Resume Next Sheets("Sheet1").Select If [IK41421] >= 2 Then Dim pwd As String: pwd = "123456" Cells(Rows.Count, Columns.Count).Activate ANS = App.PassInputBox("Enter you password", "*", "Password") If ANS <> pwd Then Sheets("Sheet1").Select Workbook.Update MsgBox " Rong Active ! Rong S.N Please tray Agien Later", 0, "You Can,t Enter Sorry " ThisWorkbook.Save ThisWorkbook.Close Else Range("IK41421").Value = 0 Range("A1").Select End If End If End Sub جرب وشوف
محمد عبد الناصر قام بنشر أغسطس 1, 2015 الكاتب قام بنشر أغسطس 1, 2015 مش عارف حضرتك والله عملت كل الخطوات صح بس بيجبلى ايرور ممكن حضرتك تعملهالى ف ملف من عندك انا اسف ؟
ياسر خليل أبو البراء قام بنشر أغسطس 1, 2015 قام بنشر أغسطس 1, 2015 جرب الملف التالي InputBox Password Mask.rar
محمد عبد الناصر قام بنشر أغسطس 1, 2015 الكاتب قام بنشر أغسطس 1, 2015 حضرتك برضو نفس المشكله الى بتواجهنى مش بلحق اكتب الباسورد
ياسر خليل أبو البراء قام بنشر أغسطس 1, 2015 قام بنشر أغسطس 1, 2015 (معدل) أنا جربت الملف ويعمل بشكل جيد على أوفيس 2013 ممكن أحد الأخوة الكرام يجرب ويقولنا على النتيجة فيه فكرة تانية إنك تستخدم فورم لإدخال كلمة السر أفضل من صندوق الإدخال ومن خلال الفورم تضع مربع نص وتخلي خاصية معينة Input Mask تخلي جمبها علامة نجمة عشان يظهر الباسورد على شكل نجوم تم تعديل أغسطس 1, 2015 بواسطه ياسر خليل أبو البراء
مختار البركاني قام بنشر أغسطس 2, 2015 قام بنشر أغسطس 2, 2015 شكرا استاذ ياسر ايضا انا جربت الملف وشغال
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.