Excel VBA Input box

前端 未结 5 1521
说谎
说谎 2020-12-06 06:52

I have following Input box for excel file. I don\'t want to show typing characters and need to show input box characters * , how to do this?

Private Sub Wor         


        
5条回答
  •  感动是毒
    2020-12-06 07:32

    I know this is an old question, but Bhanu Pratap's code from Daniel Khan required updating before I could use it in Office 365. That code was written for a 32-bit Excel environment, but the modern Excel uses a 64-bit environment and returns errors on his code. I almost thought I would not be able to salvage his code! Since I finally found out how to make it work, I wanted to post it here in-case anyone else also finds it useful.

    Excel 64-bit Code:

    Option Explicit
    
    '////////////////////////////////////////////////////////////////////
    'Password masked inputbox
    'Allows you to hide characters entered in a VBA Inputbox.
    '
    'Code written by Daniel Klann
    'March 2003
    '
    'Code updated by Joseph for Excel 64-bit Environments
    'February 2020
    'PtrSafe added & Long to PtrLong conversion
    'see https://social.msdn.microsoft.com/Forums/office/en-US/c414ef6d-fa9a-406c-9644-e479e7e72d0b/addressof-function-data-type-mismatch?forum=accessdev
    '////////////////////////////////////////////////////////////////////
    
    'API functions to be used
    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
    
    '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 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    '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
    
    Public Function InputBoxDK(Prompt, Title) As String
        Dim lngModHwnd As LongPtr, lngThreadID As LongPtr
    
        lngThreadID = GetCurrentThreadId
        lngModHwnd = GetModuleHandle(vbNullString)
    
        hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    
        InputBoxDK = InputBox(Prompt, Title)
        UnhookWindowsHookEx hHook
    End Function
    

提交回复
热议问题