2019年7月13日17:30:56已关闭评论 5,028 views

微信公众号【EXCEL880】 QQ群【341401932】
课程咨询加我微信EXCEL880B 试学网址http://v.excel880.com

操作动画如下

我们都知道Excel vba中可以用inputbox接受用户输入，在某些简单的情况下，这个方法特别方便，但是他有一个缺陷，就是如果我们希望输入密码的时候不让别人看见，就比较难办，我们希望在输入的时候输入的字符显示为*，没有办法可以直接设置，这里介绍一个黑科技，让inputbox输入框在输入的时候也能和正常的密码输入框一样输入为*

这里要用到一个高级技术，winapi，代码原理有点复杂，不过大家不用搞那么清楚，知道怎么调用就行了，只需要把下面的代码复制到一个模块中，按我下面的方式调用即可

具体原理都在代码的注释里写明了有兴趣的可以研究下，过程如下：调用系统定时器，没隔50毫秒

文本代码在文章最后面

使用说明，下面代码整体复制到你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 '静态变量

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