VBA Excel输入框中的屏蔽密码 [英] Masking Password in VBA Excel Input Box

问题描述

有人可以帮我掩盖输入到使用以下代码生成的输入框中的密码吗?我将使用Office 365 ProPlus.

Could someone please help me to mask the password entered to the input box generated using the below code. I will be using Office 365 ProPlus.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim sPassCheck As String
    Dim rng As Range
    Dim sTemp As String
    Dim sPassword As String

    sPassword = "12345"
    sTemp = "You must enter the password to delete data"

    ' Check if target is within Range N6:N100000
    If Intersect(Target, Range("N6:N100000")) Is Nothing Then

        If Target.Count > 1 Then
            Set rng = Target.Cells(1, 1)
        Else
            Set rng = Target
        End If


        If rng.Value = "" Then

            sPassCheck = InputBox(sTemp, "Delete check!")

            Application.EnableEvents = False

            If sPassCheck <> sPassword Then Application.Undo

        End If
    End If

    Application.EnableEvents = True
End Sub

推荐答案

在评论上的链接应该可以解决您的问题.这就像相同的代码.首先将下面的代码复制并粘贴到模块中

Above link on comment should solve your problem. Here is like same codes. First copy and past below codes to a module

Option Explicit
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, _
    ByVal ncode As LongPtr, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr

Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
    (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr

Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr

Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, _
ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr

Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr

Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private hHook As LongPtr


Public Function NewProc(ByVal lngCode As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Dim RetVal
    Dim strClassName As String, lngBuffer As LongPtr

    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
        RetVal = GetClassName(wParam, strClassName, lngBuffer)
        If Left$(strClassName, RetVal) = "#32770" Then
            SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If
    End If

    CallNextHookEx hHook, lngCode, wParam, lParam
End Function

Public Function PasswordBox(Prompt, Title) As String
    Dim lngModHwnd As LongPtr, lngThreadID As LongPtr

    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)

    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)

    PasswordBox = InputBox(Prompt, Title)
    UnhookWindowsHookEx hHook
End Function

然后从工作簿中的任何位置调用 PasswordBox()函数.

Then call PasswordBox() function from any where in workbook like.

Sub MaskedPassword()
    Range("A1") = PasswordBox("Enter your password.", "Paasword")
End Sub

这篇关于VBA Excel输入框中的屏蔽密码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！