Excel黑科技 vba中用Inputbox對話框接受輸入密碼時顯示為*

hjr231 2019-04-25

展開全文

操作動畫如下

Excel黑科技 vba中用Inputbox對話框接受輸入密碼時顯示為*

我們都知道Excel vba中可以用inputbox接受用戶輸入，在某些簡單的情況下，這個方法特別方便，但是他有一個缺陷，就是如果我們希望輸入密碼的時候不讓別人看見，就比較難辦，我們希望在輸入的時候輸入的字符顯示為*，沒有辦法可以直接設置，這里介紹一個黑科技，讓inputbox輸入框在輸入的時候也能和正常的密碼輸入框一樣輸入為*

Excel黑科技 vba中用Inputbox對話框接受輸入密碼時顯示為*

這里要用到一個高級技術，winapi，代碼原理有點復雜，不過大家不用搞那么清楚，知道怎么調用就行了，只需要把下面的代碼復制到一個模塊中，按我下面的方式調用即可

具體原理都在代碼的注釋里寫明了有興趣的可以研究下，過程如下：調用系統(tǒng)定時器，沒隔50毫秒

Excel黑科技 vba中用Inputbox對話框接受輸入密碼時顯示為*

文本代碼在文章最后面

使用說明，下面代碼整體復制到你vba模塊中，然后在需要調用帶密碼inputbox的地方

以前比如你寫的 s=inputbox() 現在把inputbox改成pswdInputBox即可

Option Explicit
'API宣告
#If Win64 Then
Private Declare PtrSafe Function FindWindow Lib 'user32' Alias 'FindWindowA' (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib 'user32' Alias 'FindWindowExA' (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib 'user32' Alias 'SendMessageA' (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function timeSetEvent Lib 'winmm.dll' (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As LongPtr, ByVal dwUser As LongPtr, ByVal uFlags As Long) As Long
Private Declare PtrSafe Function timeKillEvent Lib 'winmm.dll' (ByVal uID As Long) As Long
#Else
Private Declare Function FindWindow Lib 'user32' Alias 'FindWindowA' (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib 'user32' Alias 'FindWindowExA' (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib 'user32' Alias 'SendMessageA' (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function timeSetEvent Lib 'winmm.dll' (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
Private Declare Function timeKillEvent Lib 'winmm.dll' (ByVal uID As Long) As Long
#End If
'timeSetEvent函數請參考MSDN
Private Const EM_SETPASSWORDCHAR = &HCC
Dim lTimeID As Long 'Timer ID
Const pswdInputBoxTitle = 'pswdInputBox' '輸入密碼的對話框標題
'TimeProc callback 函數請參考MSDN
Sub TimeProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, _
ByVal dw1 As Long, ByVal dw2 As Long)
Dim hwd As LongPtr '輸入密碼的對話框句柄
'VBA InputBox對話框之Class Name是 '#32770',
'標題為 'pswdInputBox', 這是在InputBox函數的Title引述中自訂的
'請注意Application.InputBox方法所出現的對話框Class Name是 'bosa_sdm_XL9'
hwd = FindWindow('#32770', pswdInputBoxTitle)
If hwd <> 0 Then '若對話框存在
'取得輸入的文字框句柄, 該文字框的Class Name是'Edit', 無標題,
'而Application.InputBox方法所出現的對話框之文字框的Class Name是'EDTBX'
hwd = FindWindowEx(hwd, 0, 'Edit', vbNullString)
'設定密碼字符為 '*', '*'的ASCII碼為42
SendMessage hwd, EM_SETPASSWORDCHAR, 42, 0
'設定完成, 取消定時器
timeKillEvent lTimeID
End If
End Sub
'自定義函數pswdInputBox, 是一個輸入密碼使用的InputBox, 輸入的內容都以 '*' 顯示.
Function pswdInputBox() As Variant
'啟動一個特定的Timer事件, 0.01秒延遲, 0.05秒看一次
lTimeID = timeSetEvent(10, 50, AddressOf TimeProc, 1, 1)
'顯示InputBox對話框
pswdInputBox = InputBox(Prompt:='請輸入管理員密碼', Title:=pswdInputBoxTitle)
End Function
Sub TestpswdInputBox()
Dim s
Static x As Integer '靜態(tài)變量
s = pswdInputBox '在自己的代碼中只需要這一句調用代替以前的inbutbox即可
If s = '' Then Exit Sub
If s = '123456' Then
MsgBox '管理員登錄成功'
Else
x = x + 1
If x = 3 Then
MsgBox '你已經3次輸入密碼,電腦即將爆炸!'
x = 0
Exit Sub
End If
MsgBox '密碼已輸入錯誤' & x & '次,請重新輸入'
TestpswdInputBox
End If
End Sub