[已解决][分享]VBA高亮显示当前输入控件

吕?布 · 发表于 2011-4-15 10:58

本帖最后由吕?布于 2011-4-17 00:21 编辑

12楼有飞翔版主用API方法实现的示例文档，应该更好

前几天看了mxg825的高亮要求，开始觉得简单，然后发现VBA还很烦的。最终觉得要用类模块，用自定义事件。终于在网上找到一个原型(佩服老外的研究精神和分享精神)。然后经过改动和调整：
1. 可以适用于框架里的控件，
2. 另外也应要求修改的CheckBox的情况，能够还原成底色(我是硬编码在里面的)
3. 另外加上了一些注解，希望对想研究类模块的人有帮助
效果图.gif

类模块代码
'--Class Module Code (named Class1)

Public Event GetFocus(ByVal strCtrl As String)
Public Event LostFocus(ByVal strCtrl As String)
Private strPreCtr As String    ' 切换前一个控件
Private strCurCtr As String    ' 切换后当前控件

Public Sub CheckActiveCtrl(objForm As MSForms.UserForm)
Dim sActualActiveCtrlName As String
With objForm
      ' 初始化
      If (TypeOf .ActiveControl Is MSForms.ComboBox) Or _
         (TypeOf .ActiveControl Is MSForms.TextBox) Or _
         (TypeOf .ActiveControl Is MSForms.CheckBox) Then
         strCurCtr = .ActiveControl.Name
         On Error GoTo Terminate
         Do       ' 界面切换输入焦点
            DoEvents
            If .ActiveControl.Name <> strPreCtr Then
                  If (TypeOf .ActiveControl Is MSForms.Frame) Then
                     ' 框架上的活动控件要用UserForm.Frame.ActiveControl的形式取到得
                     sActualActiveCtrlName = .ActiveControl.ActiveControl.Name
                  Else
                     ' 窗体上活动控件用UserForm.ActiveControl的形式取得
                     sActualActiveCtrlName = .ActiveControl.Name
                  End If
                  ' 对ComboBox,TextBox,CheckBox类进行处理,Frame必须也包含在内,这样才会对框架内指定控件生效
                  If (TypeOf .ActiveControl Is MSForms.ComboBox) Or _
                     (TypeOf .ActiveControl Is MSForms.TextBox) Or _
                     (TypeOf .ActiveControl Is MSForms.CheckBox) Or _
                     (TypeOf .ActiveControl Is MSForms.Frame) Then
                     strPreCtr = strCurCtr
                     RaiseEvent LostFocus(strPreCtr)
                     strCurCtr = sActualActiveCtrlName
                     RaiseEvent GetFocus(strCurCtr)
                  End If
            End If
         Loop
      End If
End With
Terminate:
Exit Sub
End Sub

窗体代码
'--Userform1 modile Code

Option Explicit

Private WithEvents objForm As Class1

Private Sub UserForm_Initialize()
Set objForm = New Class1

ComboBox1.List() = Array("A", "b", "C")
ComboBox2.List() = Array("O", "P", "Q")
ComboBox3.List() = Array("个", "只", "件")
End Sub

Private Sub UserForm_Activate()
' Me.TextBox7.SetFocus
If (TypeOf ActiveControl Is MSForms.ComboBox) Or _
   (TypeOf ActiveControl Is MSForms.TextBox) Or _
   (TypeOf ActiveControl Is MSForms.CheckBox) Then
      ActiveControl.BackColor = RGB(0, 255, 0)
End If
objForm.CheckActiveCtrl Me

End Sub

Private Sub objForm_GetFocus(ByVal strCtrl As String)
Me.Controls(strCtrl).BackColor = RGB(0, 255, 0)
End Sub

Private Sub objForm_LostFocus(ByVal strCtrl As String)
Dim ctrl As MSForms.Control
Set ctrl = Me.Controls(strCtrl)
If (TypeOf ctrl Is MSForms.ComboBox) Or _
   (TypeOf ctrl Is MSForms.TextBox) Then
      Me.Controls(strCtrl).BackColor = RGB(255, 255, 255)
ElseIf (TypeOf ctrl Is MSForms.CheckBox) Then
      Me.Controls(strCtrl).BackColor = &H8000000F
End If
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set objForm = Nothing
End Sub

高亮显示当前文本框(复合框)_能响应Frame_修正版.rar (15.39 KB, 下载次数: 134)

阿童木 · 发表于 2011-4-15 11:04

RaiseEvent LostFocus(strPreCtr)和RaiseEvent GetFocus(strCurCtr)两个事件是本例的精髓

mxg825 · 发表于 2011-4-15 11:12

多谢吕布老师的解答。。。
我觉得这个类很实用。。。
苦恼网上找不到相关代码。。！

wbzxz · 发表于 2011-4-15 15:16

回复吕?布的帖子

吕布老师都是从哪里找来的这么好的东东啊？
现在想想，英语没学好，真是一大损失啊，唉。

wbzxz · 发表于 2011-4-15 15:20

唉，我始终理解不了，这个DoEvents，在do loop循环里面是起的什么作用。

吕?布 · 发表于 2011-4-15 16:07

do loop是个无限循环，起监视ActiveControl变更的作用，
DoEvents转让控制权，以便让操作系统处理其它的事件。这里主要是用户界面。如果没有就是死循环了

mxg825 · 发表于 2011-4-15 21:15

奇怪的问题：我把以上代码放进一个以前现有的窗体中，无法应用！新建一个窗体，把控件和代码原封不动复制过来，就可以了！不知道为什么？明天再试试

mxg825 · 发表于 2011-4-16 09:32

本帖最后由 mxg825 于 2011-4-16 09:40 编辑

问题解决了！
问题出在【窗体TAB键顺序】
原来是Frame在最前面！
换成Textbox 在最前面！就解决了！

还是Frame在作怪。。。我尽量不要使用他！

年龄 · 发表于 2011-4-16 10:13

好东东

HYY514 · 发表于 2011-4-16 19:31

do
doevents
loop
开销很大的，打开CPU看看就知道了

		自动登录	找回密码
密码			注册

[已解决][分享]VBA高亮显示当前输入控件

评分

点评