officeba > 单独文章


介绍一个输入密码用的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函数请参考:https://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 函数请参考:https://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


声明:欢迎各大网站转载本站文章,还请保留一条能直接指向本站的超级链接,谢谢!

时间:2007-09-25 21:19:56,点击:65824


【OfficeBa论坛】:阅读本文时遇到了什么问题,可以到论坛进行交流!Excel专家邮件:342327115@qq.com(大家在Excel使用中遇到什么问题,可以咨询此邮箱)。

【声明】:以上文章或资料除注明为Office自创或编辑整理外,均为各方收集或网友推荐所得。其中摘录的内容以共享、研究为目的,不存在任何商业考虑。如有任何异议,请与本站联系,本站确认后将立即撤下。谢谢您的支持与理解!


相关评论

我要评论

评论内容