相关文章推荐
小百科  ›  一句话使得VBA窗体积极行动Esc键 - 知乎
sub vba
成熟的春卷
1 年前
一句话让VBA窗体响应Esc键

一句话让VBA窗体响应Esc键

1 年前 · 来自专栏 VBAer有乾坤

从此以后，窗体初始化中加一句 SetFormAction_KeyPress Me 就能实现各种神奇的操作啦。

本章主要讲解VBA的窗体加入一句话便可在该窗体页面和控件响应的Esc键并统一做出窗体的Unload Me结果。话说别的别人的各种花哨的窗体都能实现，小不懂可想知道怎么做的了。这个直观感受和效率可是很棒的。并由此，我们可以想到还能做更多事情，事先，我们先把Esc这个功能实现一下。

构建类：响应KeyPress

先定个类名吧：myKeyPressCls

构建类之前，小不懂先查了一下窗体及控件怎么响应按键的，原来是KeyPress事件驱动。那顺便，看看哪些控件包含这个事件。查得全量控件如图1。

图1

也就是说比如Label控件是没有KeyPress事件的，事先框定范围是很重要的呢，可不能画蛇添足弄崩程序。

先一把这些写如类里面。通过定义成 WithEvents 这样我们就有了能响应事件的效果了。 

'此代码适用于VBA，请勿在VB.net中使用
Public WithEvents myCheckBox As MSForms.CheckBox
Public WithEvents myComboBox As MSForms.ComboBox
Public WithEvents myCommandButton As MSForms.CommandButton
Public WithEvents myFrame As MSForms.Frame
Public WithEvents myListBox As MSForms.ListBox
Public WithEvents myMultiPage As MSForms.MultiPage
Public WithEvents myOptionButton As MSForms.OptionButton
Public WithEvents myScrollBar As MSForms.ScrollBar
Public WithEvents myTabStrip As MSForms.TabStrip
Public WithEvents myToggleButton As MSForms.ToggleButton
Public WithEvents myUserForm As MSForms.UserForm
Public WithEvents mySpinButton As MSForms.SpinButton
Public WithEvents myTextBox As MSForms.TextBox

为了能在测试的时候看看是不是能响应按键增加类的ShowKey as Boolean属性，并在类初始化为False。 

'此代码适用于VBA，请勿在VB.net中使用
Private myShowKey As Boolean
Private Sub Class_Initialize()
    ShowKey = False
End Sub
Public Property Let ShowKey(ByVal isToShowKey As Boolean)
    myShowKey = isToShowKey
End Property
Public Property Get ShowKey() As Boolean
    ShowKey = myShowKey
End Property

很显然，还要传入要Unload的对象，定义成Forms as object。 

'此代码适用于VBA，请勿在VB.net中使用
Private myForms As Object
Public Property Set Forms(Obj)
    Set myForms = Obj
End Property
Public Property Get Forms() As Object
    Set Forms = myForms
End Property

再实现Unload效果，当然是不是ShowKey也在这个时候实现。 

'此代码适用于VBA，请勿在VB.net中使用
Private Sub UloadForms(ByVal KeyAscii As MSForms.ReturnInteger)
    If ShowKey = True Then
        MsgBox Chr(KeyAscii)
    End If
    If KeyAscii = 27 Then
        Unload myForms
    End If
End Sub

再把所有的真实动作响应起来。 

'此代码适用于VBA，请勿在VB.net中使用
Private Sub myTextBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub mySpinButton_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myUserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myToggleButton_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myTabStrip_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myScrollBar_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myOptionButton_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myMultiPage_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myListBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myFrame_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myCommandButton_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myComboBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myCheckBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub

这样一个能响应KeyPress的类就构建好了。

整合如下： 

'此代码适用于VBA，请勿在VB.net中使用
Option Explicit
Public WithEvents myCheckBox As MSForms.CheckBox
Public WithEvents myComboBox As MSForms.ComboBox
Public WithEvents myCommandButton As MSForms.CommandButton
Public WithEvents myFrame As MSForms.Frame
Public WithEvents myListBox As MSForms.ListBox
Public WithEvents myMultiPage As MSForms.MultiPage
Public WithEvents myOptionButton As MSForms.OptionButton
Public WithEvents myScrollBar As MSForms.ScrollBar
Public WithEvents myTabStrip As MSForms.TabStrip
Public WithEvents myToggleButton As MSForms.ToggleButton
Public WithEvents myUserForm As MSForms.UserForm
Public WithEvents mySpinButton As MSForms.SpinButton
Public WithEvents myTextBox As MSForms.TextBox
Private myShowKey As Boolean
Private myForms As Object
Private Sub Class_Initialize()
    ShowKey = False
End Sub
Public Property Let ShowKey(ByVal isToShowKey As Boolean)
    myShowKey = isToShowKey
End Property
Public Property Get ShowKey() As Boolean
    ShowKey = myShowKey
End Property
'定位到Forms
Public Property Set Forms(Obj)
    Set myForms = Obj
End Property
Public Property Get Forms() As Object
    Set Forms = myForms
End Property
Private Sub UloadForms(ByVal KeyAscii As MSForms.ReturnInteger)
    If ShowKey = True Then
        MsgBox Chr(KeyAscii)
    End If
    If KeyAscii = 27 Then
        Unload myForms
    End If
End Sub
Private Sub myTextBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub mySpinButton_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myUserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myToggleButton_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myTabStrip_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myScrollBar_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myOptionButton_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myMultiPage_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myListBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myFrame_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myCommandButton_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myComboBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub
Private Sub myCheckBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    UloadForms KeyAscii
End Sub

构建模块：完成一键响应

构建模块，命名为PublicBAS_15_KeyPress，全局过程 SetFormAction_KeyPress。直接上代码，好像没什么要解释，苦笑ing。 

'此代码适用于VBA，请勿在VB.net中使用
Option Explicit
Private MyControls As New Collection
Private myForms  As Object
'定位到Forms
Public Sub SetFormAction_KeyPress(ByRef Obj As Object)
    Set myForms = Obj
    Call mySetForm_KeyPress
End Sub
Private Sub mySetForm_KeyPress()
    Dim EachControl
    Dim MyCls As myKeyPressCls
    Set MyCls = New myKeyPressCls
    Set MyCls.myUserForm = myForms
    'UserForm自身响应起来
    Set MyCls.Forms = myForms
    MyControls.Add MyCls
    '轮循Controls，符合条件的响应起来
    For Each EachControl In myForms.Controls
        Set MyCls = New myKeyPressCls
        Select Case TypeName(EachControl)
            Case "SpinButton"
                Set MyCls.Forms = myForms
                Set MyCls.mySpinButton = EachControl
                MyControls.Add MyCls
            Case "ToggleButton"
                Set MyCls.Forms = myForms
                Set MyCls.myToggleButton = EachControl
                MyControls.Add MyCls
            Case "TabStrip"
                Set MyCls.Forms = myForms
                Set MyCls.myTabStrip = EachControl
                MyControls.Add MyCls
            Case "ScrollBar"
                Set MyCls.Forms = myForms
                Set MyCls.myScrollBar = EachControl
                MyControls.Add MyCls
            Case "OptionButton"
                Set MyCls.Forms = myForms
                Set MyCls.myOptionButton = EachControl
                MyControls.Add MyCls
            Case "MultiPage"
                Set MyCls.Forms = myForms
                Set MyCls.myMultiPage = EachControl
                MyControls.Add MyCls
            Case "ListBox"
                Set MyCls.Forms = myForms
                Set MyCls.myListBox = EachControl
                MyControls.Add MyCls
            Case "Frame"
                Set MyCls.Forms = myForms
                Set MyCls.myFrame = EachControl
                MyControls.Add MyCls
            Case "ComboBox"
                Set MyCls.Forms = myForms
                Set MyCls.myComboBox = EachControl
                MyControls.Add MyCls
            Case "CheckBox"
                Set MyCls.Forms = myForms
                Set MyCls.myCheckBox = EachControl
                MyControls.Add MyCls
            Case "TextBox"
                Set MyCls.Forms = myForms
                Set MyCls.myTextBox = EachControl
                MyControls.Add MyCls
            Case "CommandButton"
                Set MyCls.Forms = myForms
                Set MyCls.myCommandButton = EachControl
                MyControls.Add MyCls
            Case Else
        End Select
    Set MyCls = Nothing
End Sub

上述代码中的Case不是水代码哈，每个人的需求都不一样，可能需要在每个内部嵌入新过程，就可以直接加了，代码改动很小。

在UserForm中调用方式： 

'此代码适用于VBA，请勿在VB.net中使用
SetFormAction_KeyPress MSForms

实战应用：初始化即响应

UserForm的Initialize直接初始化示例： 

'此代码适用于VBA，请勿在VB.net中使用
Private Sub UserForm_Initialize()
    SetFormAction_KeyPress Me
End Sub

实战配置案例

更多功能配备

现在既然都能响应Esc键了，那么其他特殊按键那就是手到擒来。

至于要响应哪个特殊键位： 

'此代码适用于VBA，请勿在VB.net中使用
ShowKey = True
'之后用下面任一句，建议第二句更好。然后再去拦截KeyAscii值。
debug.print(Chr(KeyAscii))
debug.print(KeyAscii)

More things：暗桩

暗桩是程序保护的方式之一，并不是什么黑话。 大家都知道VBA的保护能力差，所以大家可能转了VB6封装为dll，但是VB6依然可以被跟踪。譬如注册破解等情况，这时候，我们就需要做一些暗桩，不定时又有一定概率触发一些新的验证措施，如果跟踪KeyPress就是一个不错的方式。比如我们可以修改UloadForms为 

'此代码适用于VBA，请勿在VB.net中使用
Private myKeyStr As String
Private myMultiStrikeStrikeCount As Integer
Private myMultiStrikeStrikeAscii
Private Sub Class_Initialize()
    ShowKey = False
    myMultiStrikeStrikeAscii = 1
End Sub
'固定按键顺序触发机制
Private Sub HiddenPiles_FixedStr(ByVal KeyAscii As MSForms.ReturnInteger)
    '暗桩过程---------封装成dll后就很难发现了-------------------------------
    myKeyStr = myKeyStr & Chr(KeyAscii)
    'MsgBox myKeyStr
    If Len(myKeyStr) >= 3 Then
        myKeyStr = Right(myKeyStr, 3)
        '要执行的暗桩程序，尽量实现并保持小概率
        Select Case myKeyStr
            '隐蔽触发机制示例1
            Case "111", "222", "333", "444", "555", "666", "777", "888", "999", "000"
                MsgBox "三连触发"
            '隐蔽触发机制示例2
            Case "012", "123", "234", "345", "456", "567", "678", "789"
                MsgBox "顺序触发"
            '隐蔽触发机制N
            'Case
            Case Else
        End Select
    End If
    '暗桩过程OVER-------这样在别人破解的过程中是很难发现的---------
End Sub
'连续按键N次触发机制
Private Sub HiddenPiles_MultiStrike(ByVal KeyAscii As MSForms.ReturnInteger)
    '暗桩过程---------封装成dll后就很难发现了-------------------------------
    If myMultiStrikeStrikeAscii = KeyAscii Then
        '防止计数溢出
        If myMultiStrikeStrikeCount > 100 Then
            myMultiStrikeStrikeCount = 11  '此数要大于后续的门限设置
        End If
        '计数器+1
        myMultiStrikeStrikeCount = myMultiStrikeStrikeCount + 1
        '第1次触发门限制
        If myMultiStrikeStrikeCount = 5 Then
            MsgBox "5连触发"
        End If
        '第2次触发门限制
        If myMultiStrikeStrikeCount = 10 Then
            MsgBox "10连触发"
        End If
        '第N次触发门限制
        '换键之后重置
        myMultiStrikeStrikeAscii = KeyAscii
        myMultiStrikeStrikeCount = 1
    End If
    '暗桩过程OVER-------这样在别人破解的过程中是很难发现的---------
End Sub
Private Sub UloadForms(ByVal KeyAscii As MSForms.ReturnInteger)
    '固定按键触发
    Call HiddenPiles_FixedStr(KeyAscii)
    '连续按键触发
    Call HiddenPiles_MultiStrike(KeyAscii)
    If ShowKey = True Then
 
推荐文章
今天看啥   ·   Py中国   ·   codingpro   ·   藏经阁   ·   小百科   ·   link之家   ·   卧龙AI搜索
删除内容请联系邮箱 2879853325@qq.com
小百科 - 百科知识指南
© 2024 ~ 沪ICP备11025650号