شاشة ادخال الرقم السري

[salahawwad90]

السلام عليكم

هل يمكن المساعدة بجعل الرقم السري مخفي او اظهار * بدل الرقم السري حسب الصورة المرفقة وحسب الكود التالي 

مع الشكر

Private Sub CommandButton9_Click()

Dim lrow As Long
    Dim password As String
    Dim inputPassword As String
    Dim username As String
    Dim ws As Worksheet
    Set ws = list

    username = ws.Range("O2").Value

    lrow = ws.Cells(ws.Rows.Count, 12).End(xlUp).Row
    For i = 2 To lrow
        If ws.Cells(i, 12).Value = username Then
            password = ws.Cells(i, 13).Value
            Exit For
        End If
    Next i

    inputPassword = InputBox("يرجى إدخال كلمة السر:", "تحقق من كلمة السر")

    If inputPassword = password Then
        ' تعطيل التحديثات والأحداث والحسابات
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.Calculation = xlCalculationManual
        
        ThisWorkbook.Save
        
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        
        Me.Hide
Application.Visible = True
    Else
        MsgBox "الرجاء التأكد من كلمة السر!"
    End If

End Sub
 

[hegazee]

من خصائص User form

أفعل كما هو موضح بالصورة و ضع نجمة مقابل passwordChar

تم تعديل أغسطس 23 بواسطه hegazee

[محمد هشام.]

اخي الفاضل مربع inputbox  في Excel لا يدعم إخفاء كلمة السر أو إظهارها كنجوم أو علامات. هو ببساطة يعرض مربع حوار لإدخال النص دون تقديم خيارات لتنسيق العرض مثل إخفاء النص.

 

لإخفاء كلمة السر أو إظهارها كنجوم، يجب عليك استخدام Userform  الذي يتيح لك تخصيص واجهة المستخدم بشكل أكبر. يمكنك استخدام خاصية  PasswordChar لمربع النص (Textbox) لعرض كلمات المرور كنجوم أو أي رمز آخر تختاره 

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

 

مع اظافة ورقة خاصة بتسجيل الزوار باسم AccessLog لتتبع المستخدمين والمدة المستغرقة في استخدام الملف 

هدا مجرد اقتراح بسيط للفائدة فقط 

اليك الكود مع الشرح لتتمكن من تعديله بما يناسبك

Private Sub UserForm_Initialize()
    Set f = Sheets("list")
    Set MonDico = CreateObject("Scripting.Dictionary")
    
    ' قراءة القيم من العمود L، بدءًا من الخلية L2 حتى آخر خلية بها بيانات
    a = f.Range("l2:l" & f.[L65000].End(xlUp).Row).Value
    
    For i = LBound(a) To UBound(a)
        ' إضافة القيم غير الفارغة إلى Dictionary (القيم الفريدة فقط)
        If a(i, 1) <> "" Then MonDico(a(i, 1)) = ""
    Next i
    
    Me.ComboBox1.List = MonDico.keys
End Sub
Private Sub CommandButton1_Click()
    Dim ws As Worksheet, logWs As Worksheet
    Dim lrow As Long, clé As String
    Dim password As String, Xtime As String
    Static AttemptCount As Integer, username As String

    ' تعيين ورقة العمل "list"
    Set ws = ThisWorkbook.Sheets("list")
    
    ' تعيين ورقة العمل للتسجيل
    Set logWs = ThisWorkbook.Sheets("AccessLog")

    ' الحصول على اسم المستخدم من ComboBox
    username = ComboBox1.Value
    
    ' التحقق إذا كان اسم المستخدم مدخل
    If username = "" Then
        MsgBox "يرجى اختيار اسم المستخدم.", vbExclamation
        Exit Sub
    End If

    ' العثور على آخر صف يحتوي على بيانات في العمود 12 (L)
    lrow = ws.Cells(ws.Rows.Count, 12).End(xlUp).Row

    ' البحث عن كلمة السر المرتبطة بالاسم
    For i = 2 To lrow
        If ws.Cells(i, 12).Value = username Then
            password = ws.Cells(i, 13).Value
            Exit For
        End If
    Next i

    ' الحصول على كلمة السر المدخلة من مربع النص
    clé = TextBox1.Text

    ' التحقق إذا كانت كلمة السر المدخلة صحيحة
    If clé = password Then
        ' تسجيل الدخول الناجح
With logWs
    ' العثور على آخر صف فارغ في الأعمدة A, B, C و D
    lrow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    .Cells(lrow, 1).Value = username
    .Cells(lrow, 2).Value = Date
    .Cells(lrow, 3).Value = Format(Time, "hh:mm:ss") ' توقيت الدخول فقط كوقت
    .Cells(lrow, 4).Value = "دخول ناجح" ' إضافة رسالة تسجيل الدخول الناجح
End With

        ' عرض رسالة ترحيب
        MsgBox "مرحبا " & username & "، لقد تم تسجيل الدخول بنجاح!", vbInformation
        
        ' إظهار Excel
        Application.Visible = True
        ' إغلاق  UserForm
        Unload Me
        ' إعادة تعيين عدد المحاولات
        AttemptCount = 0
    Else
        ' معالجة الدخول الفاشل
        AttemptCount = AttemptCount + 1
        
        If AttemptCount >= 3 Then
            MsgBox "لقد تجاوزت عدد المحاولات المسموح بها. سيتم حفظ وإغلاق الملف.", vbExclamation
            ThisWorkbook.Save
            Application.Quit
        Else
            MsgBox "الرجاء التأكد من كلمة السر! المحاولة " & AttemptCount & " من 3"
            Me.TextBox1.Text = ""
        End If
    End If
End Sub
Private Sub CommandButtonClose_Click()
    Dim answer As VbMsgBoxResult
    answer = MsgBox("هل أنت متأكد من الخروج من البرنامج؟", vbYesNo + vbQuestion, "تأكيد الإغلاق")
    If answer = vbYes Then
        ' حفظ المصنف
        ThisWorkbook.Save
        
        ' إغلاق المصنف
        ThisWorkbook.Close SaveChanges:=False
          Application.Quit
    End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then
        Cancel = True
        MsgBox "يرجى استخدام زر الإغلاق المخصص لإغلاق النموذج", vbInformation
    End If
End Sub

 

وفي حدث ThisWorkbook

Private Sub Workbook_Open()
    Application.Visible = False
    UserForm1.Show
End Sub
'****************************************
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim logWs As Worksheet
    Dim lrow As Long
    Dim currentTime As Date
    Dim entryTime As Date
    
    On Error Resume Next

    Set logWs = ThisWorkbook.Sheets("AccessLog")
    
    If logWs Is Nothing Then
        MsgBox "ورقة العمل 'AccessLog' غير موجودة.", vbExclamation
        Exit Sub
    End If

    ' الحصول على الوقت الحالي
    currentTime = Now

    ' العثور على آخر صف يحتوي على بيانات
    lrow = logWs.Cells(logWs.Rows.Count, 1).End(xlUp).Row

    ' التحقق إذا كان هناك سجل سابق لتوقيت الدخول
    If lrow > 1 Then
        ' الحصول على توقيت الدخول
        entryTime = logWs.Cells(lrow, 3).Value

        ' تسجيل توقيت الخروج
        With logWs
            .Cells(lrow, 4).Value = Format(currentTime, "hh:mm:ss") ' توقيت الخروج فقط كوقت
        End With
    End If

    On Error GoTo 0 ' إلغاء التعامل مع الأخطاء

    ' حفظ المصنف
    ThisWorkbook.Save
    
    ' إغلاق المصنف
    ThisWorkbook.Close SaveChanges:=False ' تأكد من إغلاق المصنف بشكل صحيح

    ' إذا كنت تريد إغلاق Excel بالكامل، استخدم:
     'Application.Quit
    
End Sub

عند الانتهاء من تعديل برنامجك حاول وضع باسوورد لمحرر الاكواد تفاديا للتلاعب بها

كلمات المرور واسماء المستخدمين  الحالية كما في الصورة فوق

بالتوفيق....

 

 

 

 

 

 

 

شاشة دخول.xlsb

[ibrahim.]

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

تم تعديل أغسطس 24 بواسطه ibrahim.

[salahawwad90]

شكرا كثير الله يجزيكم الخير

[محمد هشام.]

5 ساعات مضت, ibrahim. said:

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

اخي ليس هناك خطا عبارة دخول ناجح مؤقتة لحين مغادرة المستخدم للملف بحيث الكود الموجود في حدث ThisWorkbook هو المسؤول على حساب التوقيت الفعلي 

يتم استبدالها تلقائيا عن تسجيل الخروج كما في الصورة ادناه قم بتغيير 

' التحقق إذا كان هناك سجل سابق لتوقيت الدخول
    If lrow > 1 Then
       

الى 

' التحقق إذا كان هناك سجل سابق لتوقيت الدخول
    If lrow > 2 Then
  

 

[ibrahim.]

جميل هذا العمل وبارك الله فيكم على التوضيح في مثل هذه المسائل المهمة

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

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

[elmansyeswa]

بارك الله فيكم