介绍一个输入密码用的InputBox函数

『自从微软提供 AddressOf 函数给VBA后，本以为对于 Excel 窗口控制从此如虎添翼，没想到只是一厢情愿，多次测试结果鲜少圆满达到效果。』这是以前曾经提过的一句话，从此以后就很少碰 CALLBACK 函数了。直到最近看到上面引用的话题，发现问题没想象的严重。像这个 TimeProc callback function 在范例中的使用效果就不错。

要去改变 VBA.InputBox 函数所带出来的对话框属性，首先就要知道该对话框的 Class Name 及其标题，还有其中对象（例如那个输入用的文字框，其 Class Name 是 “Edit”）的 Class Name 及其标题（如果有的话）。如何知道呢？这可以使用 [简易窗口检视器] 来看。怎么看？最简单的办法就是打开另一个 Excel 窗口，写个 VBA 程序叫出InputBox对话框。然后将鼠标移到上头就知道了。当然开 Word 窗口来做也可以的。如下图

有了上述信息就可以使用API：FindWindow，FindWindowEx 取得标的控件的句柄，然后使用 SendMessage 设定相关属性。这些动作都在 TimeProc callback 函数中完成。

最后使用 Windows Multimedia 函数： timeSetEvent 设定定时器，定时启动 TimeProc 函数监看，一旦 InputBox 对话框出现，完成动作随即使用timeKillEvent函数取消定时器。一点都不消耗CPU或内存。其效果如图

参考程序代码

'一般模块 Module1 程序代码

Option Explicit

'API宣告

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

'timeSetEvent函数请参考:http://msdn2.microsoft.com/en-us/library/ms713423.aspx

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

Private Const EM_SETPASSWORDCHAR = &HCC

Dim lTimeID     As Long          'Timer ID

Const pswdInputBoxTitle = "pswdInputBox"     '输入密码的对话框标题

--------------------------------------------------------------------------------

'TimeProc callback 函数请参考:http://msdn2.microsoft.com/en-us/library/ms713420.aspx

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 Long         '输入密码的对话框句柄

    '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

'工作表模块 Sheet1 程序代码

Option Explicit

--------------------------------------------------------------------------------

'选择范围改变事件

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If ActiveCell.Address = "$B$2" Then     '若作用储存格为B2时

    '呼叫pawdInputBox, 并检查返回值

    If pswdInputBox <> 123456 Then

        '密码不正确, 显示讯息

        MsgBox "对不起，密码错误，你无编辑权限!"

        '离开B2储存格

        Range("A1").Select

    End If

End If

End Sub