تعديل كود password

[Osama-2020]

اخوانى الافاضل

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

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

ارجو من سيادتكم المساعده فى تعديل الكود الموضح ليتم اظهار الباسورد على شكل نجوم (***) ولا يظهر الرقم السرى للمستخدم بما لايوثر على فاعليه الكود

جزاكم الله خيرا كثيراًً.......

رابط الملف المرفق

Private Sub CommandButton4_Click()
Dim x
x = InputBox("Please Enter Your Password")
If x = "123" Then
Sheets("Renewal").Activate
Else: Exit Sub
End If
End Sub

 

[abdelfattahbadawy]

شوف الموضوع ده يا أخى ممكن يساعدك

أو ممكن تشوف دى كمان أكواد مفتوحة 

 

[عبدالفتاح في بي اكسيل]

@Osama-2020

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

[Osama-2020]

معذرة استاذتى الافاضل

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

ارجو المساعده فى التعديل على الكود نفسه ان امكن ... وهذا سيكون اسهل لى.... 

لكم جزيل التقدير والشكر

[محمد هشام.]

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

تفضل اخي جرب  مع مثال بسيط لطلبك

Sub Unlock1()
Dim inpu1 As String, inpu2 As String
'  يمكنك وضع الباسوورد في اي شيت من اختيارك مع تحديد اسمه . وخلية الرقم السري داخل الكود كما في المثال
'(A1) وضع رقم الباسوورد في الخلية
inpu2 = Sheets("data").Range("A1").Value
inpu1 = Application.InputBox("Please Enter Your Password")
If inpu1 = inpu2 Then Sheets("Renewal").Activate

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''
Sub Unlock2()
Dim inpu1 As String, inpu2 As String

'وضع الباسوورد في شيت مخفي
'(b10) وضع الرقم السري في الخلية

inpu2 = Sheets("sheet2").Range("b10").Value
inpu1 = Application.InputBox("Please Enter Your Password")
If inpu1 = inpu2 Then Sheets("Renewal").Activate

End Sub

 

Osama-Test.xlsm

[Osama-2020]

جزيل الشكر لك اخى @Mohamed Hicham

لازل ال password يظهر كما هو على شكل ارقام

ارغب فى جعله يظهر على شكل ***** بدلا من الارقام

مع استخدام نفس الكود المرفق فى الملف وهو كالتالى:

Private Sub CommandButton1_Click()
Dim x
x = InputBox("Please Enter Your Password")
If x = "123" Then
Sheets("Data").Activate
Else: Exit Sub
End If
End Sub

[محمد هشام.]

طلبك غير منطقي هو الواحد لما هيدخل الباسوورد هيكون عرفه وفي نفس الوقت لا تريد اظهاره له ؟ @Osama-2020

[Osama-2020]

لم اطلب ذلك أخى @Mohamed Hicham

انا اطلب ان تظهر له الارقام او الباسبور التى سيقوم بكتابتها فى box massage على شكل **** او ما يعرف asterisk

 

[حسونة حسين]

جرب هذا الكود اخى

Option Explicit

'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'March 2003
'https://stackoverflow.com/questions/28189864/excel-vba-input-box
'////////////////////////////////////////////////////////////////////
'API functions to be used
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
    ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
    (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
Private hHook As Long
Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim RetVal
    Dim strClassName As String, lngBuffer As Long
    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
        Exit Function
    End If
    strClassName = String$(256, " ")
    lngBuffer = 255
    If lngCode = HCBT_ACTIVATE Then    'A window has been activated
RetVal = GetClassName(wParam, strClassName, lngBuffer)
        If Left$(strClassName, RetVal) = "#32770" Then  'Class name of the Inputbox
            'This changes the edit control so that it display the password character *.
            'You can change the Asc("*") as you please.
            SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If

    End If
    'This line will ensure that any other hooks that may be in place are
    'called correctly.
    CallNextHookEx hHook, lngCode, wParam, lParam
End Function

Function InputBoxDK(Prompt, Title) As String
    Dim lngModHwnd As Long, lngThreadID As Long
    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    InputBoxDK = InputBox(Prompt, Title)
    UnhookWindowsHookEx hHook
End Function

ولكن من الاسهل كما قال لك اخى @عبدالفتاح في بي اكسيل

استخدم userform

 قم بإنشاء userform

يحتوي على مربع نص

وزر

في خصائص مربع النص ، أدخل * في مربع

PasswordChar Box

كما بالصورة

وفي كود الزر ضع الكود الخاص بك في اول الموضوع

[Osama-2020]

جزاكم الله جميعا خيرا كثيرا.....