تعديل على كود ووحدة نمطية جزاكم الله خير

[sm44ms]

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

اليكم الكود 

والوحدة النمطية

On Error GoTo Err_clic5

    TimerId = SetTimer(0, 0, 1, AddressOf TimerProc)

    ' رسالة توضيحية لطلب إدخال كلمة المرور
    Dim str_Title As String
    Dim str_Prompt As String
    Dim userInput As String
    Dim mypass As Variant

    str_Title = "ادخال كلمة المرور"
    str_Prompt = "ادخل الرقم السري الذي تم منحة لك لدخول هذه الشاشة"
    
    ' الطلب من المستخدم إدخال كلمة المرور
    userInput = InputBox(str_Prompt, str_Title)
    
    ' البحث عن كلمة المرور في الجدول
    mypass = DLookup("[Password]", "tblUsers", "[Password] = '" & userInput & "'")

    ' التحقق مما إذا كانت كلمة المرور المدخلة تطابق أي كلمة مرور في الجدول
    If Not IsNull(mypass) Then
        ' كلمة المرور صحيحة، يستمر بفتح النموذج
        Exit Sub
    Else
        ' كلمة المرور غير صحيحة، يتم فتح نموذج الرفض وإلغاء العملية
        DoCmd.OpenForm "ACSSEC2"
        DoCmd.CancelEvent
        Exit Sub
    End If

Exit_clic5:
    Exit Sub

Err_clic5:
    DoCmd.Close
    MsgBox "تم الغاء الدخول بسبب عدم وجود صلاحيات كافية"
    Resume Exit_clic5





الوحدة النمطية 



Option Compare Database
Declare Function SetTimer Lib "user32" (ByVal hwnd _
As Long, ByVal nIDEvent As Long, ByVal uElapse _
As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long) _
As Long
Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" (ByVal hWndParent As _
Long, ByVal hWndChildAfter As Long, ByVal _
lpClassName As String, ByVal lpWindowName _
As String) As Long
Declare Function Sendmessagebynum _
Lib "user32" Alias "SendMessageA" (ByVal _
hwnd As Long, ByVal wMsg As Long, ByVal _
wParam As Long, ByVal lParam As Long) _
As Long

Const EM_SETPASSWORDCHAR = &HCC
Public str_Title$, TimerId&


Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
KillTimer 0, TimerId
Dim lng_Hwnd&
lng_Hwnd = FindWindowEx(0, 0, "#32770", _
  Trim(str_Title))
lng_Hwnd = FindWindowEx(lng_Hwnd, 0, _
  "Edit", vbNullString)
If lng_Hwnd Then
  Sendmessagebynum lng_Hwnd, EM_SETPASSWORDCHAR, 42, 0
End If
End Sub

 

اريد الباسورد على شكل نجوم ممكن

تم تعديل سبتمبر 17 بواسطه ابوخليل
تنسيق الكود ... نرجو الاهتمام بتنسيق الكود

[sm44ms]

هذا المرفق

msgpass الرقم السري على شكل نجوم.accdb

[ابو البشر]

4 ساعات مضت, sm44ms said:

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

تفضل ملفك .....

 

msgpass الرقم السري على شكل نجوم.accdb

[sm44ms]

سوف اجرب وارد لك 

اشكرك على كل حال بعد التجربة سوف اخبرك

[sm44ms]

اشكرك اخي