操作動畫如下
我們都知道Excel vba中可以用inputbox接受用戶輸入,在某些簡單的情況下,這個方法特別方便,但是他有一個缺陷,就是如果我們希望輸入密碼的時候不讓別人看見,就比較難辦,我們希望在輸入的時候輸入的字符顯示為*,沒有辦法可以直接設置,這里介紹一個黑科技,讓inputbox輸入框在輸入的時候也能和正常的密碼輸入框一樣輸入為*
這里要用到一個高級技術,winapi,代碼原理有點復雜,不過大家不用搞那么清楚,知道怎么調(diào)用就行了,只需要把下面的代碼復制到一個模塊中 ,按我下面的方式調(diào)用即可
具體原理都在代碼的注釋里寫明了有興趣的可以研究下,過程如下:調(diào)用系統(tǒng)定時器,沒隔50毫秒
使用說明,下面代碼整體復制到你vba模塊中,然后在需要調(diào)用帶密碼inputbox的地方
以前比如你寫的 s=inputbox() 現(xiàn)在把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函數(shù)請參考MSDN
Private Const EM_SETPASSWORDCHAR = &HCC
Dim lTimeID As Long 'Timer ID
Const pswdInputBoxTitle = 'pswdInputBox' '輸入密碼的對話框標題
'TimeProc callback 函數(shù)請參考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函數(shù)的Title引述中自訂的
'請注意Application.InputBox方法所出現(xiàn)的對話框Class Name是 'bosa_sdm_XL9'
hwd = FindWindow('#32770', pswdInputBoxTitle)
If hwd <> 0 Then '若對話框存在
'取得輸入的文字框句柄, 該文字框的Class Name是'Edit', 無標題,
'而Application.InputBox方法所出現(xiàn)的對話框之文字框的Class Name是'EDTBX'
hwd = FindWindowEx(hwd, 0, 'Edit', vbNullString)
'設定密碼字符為 '*', '*'的ASCII碼為42
SendMessage hwd, EM_SETPASSWORDCHAR, 42, 0
'設定完成, 取消定時器
timeKillEvent lTimeID
End If
End Sub
'自定義函數(shù)pswdInputBox, 是一個輸入密碼使用的InputBox, 輸入的內(nèi)容都以 '*' 顯示.
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 '在自己的代碼中 只需要這一句調(diào)用 代替以前的inbutbox即可
If s = '' Then Exit Sub
If s = '123456' Then
MsgBox '管理員登錄成功'
Else
x = x + 1
If x = 3 Then
MsgBox '你已經(jīng)3次輸入密碼,電腦即將爆炸!'
x = 0
Exit Sub
End If
MsgBox '密碼已輸入錯誤' & x & '次,請重新輸入'
TestpswdInputBox
End If
End Sub
聯(lián)系客服