Excel - 使用 VBA 更改用户窗体文本框和组合框的背景颜色

Excel - Change BackColor of UserForm TextBoxes and ComboBoxes with VBA

提问by

I am just learning VBA and have used some code from an older book (Excel 2010). It could be that Excel 2016 had some changes that make this code not work anymore.

我只是在学习 VBA，并使用了旧书（Excel 2010）中的一些代码。可能是 Excel 2016 进行了一些更改，使此代码不再起作用。

I do not get a compile error for the class or the Subs. The behavior is that NOTHING happens. What is supposed to happen is that the BackColor of either a ComboBox or a TextBox should change color as if is in focus or leaves focus.

我没有收到类或 Subs 的编译错误。行为是什么也没有发生。应该发生的是 ComboBox 或 TextBox 的 BackColor 应该改变颜色，就好像处于焦点或离开焦点一样。

As I said, for some reason when I run the code nothing happens. No errors or warnings appear so it's as if the code is running and then just doing nothing.

正如我所说，由于某种原因，当我运行代码时什么也没有发生。没有错误或警告出现，所以就好像代码正在运行，然后什么都不做。

Here is my code. The comments should make it clear. I am hoping someone can explain to me what is going on and why this code results in no color changes as the focus changes when I tab through the UserForm.

这是我的代码。评论应该说清楚。我希望有人可以向我解释发生了什么以及为什么当我浏览用户窗体时，当焦点发生变化时，此代码不会导致颜色发生变化。

This first block of code is a stand alone Class Module called "clsCtlColor"

第一个代码块是一个名为“clsCtlColor”的独立类模块

Public Event GetFocus()
Public Event LostFucus(ByVal strCtrl As String)
Private strPreCtr As String


'Base Class for chaging Backcolor of ComBoxes and TextBoxes when focus is changed.
Public Sub CheckActiveCtrl(objForm As MSForms.UserForm)

With objForm
    If TypeName(.ActiveControl) = "ComboBox" Or _
        TypeName(.ActiveControl) = "TextBox" Then
        strPreCtr = .ActiveControl.Name
        'On Error GoTo Terminate
        Do
            DoEvents
            If .ActiveControl.Name <> strPreCtr Then
                    If TypeName(.ActiveControl) = "ComboBox" Or _
                    TypeName(.ActiveControl) = "TextBox" Then
                    RaiseEvent LostFucus(strPreCtr)
                    strPreCtr = .ActiveControl.Name
                    RaiseEvent GetFocus
                End If
            End If
        Loop
    End If
End With

Terminate:
    Exit Sub

End Sub

The following Subs are in the UserForm Code

以下子项在用户窗体代码中

Option Explicit

Private WithEvents objForm As clsCtlColor

'*********************************************************************************************************************
'*Subs for managing the BackColor of comboxes and TextBoxes depending on focus.***************************************
'*********************************************************************************************************************


'initializes the Userform with the clsCtlColor class
Private Sub UserForm_Initialize()
Set objForm = New clsCtlColor
End Sub

'Changes the BackColor of the Active Control when the form is activated.
Private Sub UserForm_Activate()
If TypeName(ActiveControl) = "ComboBox" Or _
    TypeName(ActiveControl) = "TextBox" Then
    ActiveControl.BackColor = &H99FF33
End If
objForm.CheckActiveCtrl Me
End Sub

'Changes the BackColor of the Active Control when it gets the focus.
Private Sub objForm_GetFocus()
ActiveControl.BackColor = &H99FF33
End Sub

'Changes the BackColor back to white when the control loses focus.
Private Sub objForm_LostFocus(ByVal strCtrl As String)
Me.Controls(strCtrl).BackColor = &HFFFFFF
End Sub

'Clears the objForm when the form is closed.
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set objForm = Nothing
End Sub

In the Class Module the is an On Error Statement that terminates the Sub when an error occurs. However, I commented it out and still, I see no compile errors. So, I can only conclude it is a runtime issue.

在类模块中，有一个 On Error 语句，它在发生错误时终止 Sub。但是，我将其注释掉了，但仍然没有看到编译错误。所以，我只能得出结论，这是一个运行时问题。

Any help would be much appreciated.

任何帮助将非常感激。

UPDATE:

更新：

If I use these two subs on a TextBox I get the effect I'm looking for:

如果我在 TextBox 上使用这两个 subs，我会得到我正在寻找的效果：

Private Sub TextBox1_Enter()
TextBox1.BackColor = RGB(153, 255, 51)
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1.BackColor = RGB(255, 255, 255)
End Sub

What I hate about this is that my UserForm has over one hundred TextBoxes and I would need to write these two subs for each TextBox - so like 200++ Subs!

我讨厌这个是我的用户窗体有一百多个文本框，我需要为每个文本框编写这两个子 - 就像 200++ 子一样！

I am still trying to get the above more general approach to work.
One thing I noticed is that if I change the RGB values in the two subs above to Hex values, they no longer work. I tried changing the hex color values in the more general approach to RGB but it made no difference.

我仍在努力使上述更通用的方法发挥作用。
我注意到的一件事是，如果我将上面两个子程序中的 RGB 值更改为十六进制值，它们将不再起作用。我尝试以更通用的 RGB 方法更改十六进制颜色值，但没有任何区别。

Yet Another Update:

另一个更新：

It was pointed out that I had a typo in the class LostFucus. I changed that in two places to LostFocus. However, the code still does not work. Then the question was whether or not my code is in the userform module. It is. Then I tried an experiment. I created a new Workbook and imported the code into a brand new class and userform. I added three textboxes. Abracadabra! It worked! However, it does not work in the form I want it to work in. I have scoured the properties for the form itself and the text boxes and I can see nothing different between my form and the dummy form.

有人指出我在课堂上有错别字LostFucus。我在两个地方将其更改为LostFocus. 但是，代码仍然不起作用。然后问题是我的代码是否在用户表单模块中。这是。然后我尝试了一个实验。我创建了一个新的工作簿并将代码导入到一个全新的类和用户表单中。我添加了三个文本框。胡言乱语！有效！但是，它在我希望它使用的表单中不起作用。我已经搜索了表单本身和文本框的属性，我看不出我的表单和虚拟表单之间有什么不同。

This must be something very simple I am over looking!

这一定是我正在寻找的非常简单的东西！

回答by

After a great deal of head scratching and screaming at my poor monitor I finally found the solution but as of now, I am totally disappointed in Microsoft for the weirdness of working with UserForms. Here is what fixed the problem:

在对我糟糕的显示器进行了大量的挠头和尖叫之后，我终于找到了解决方案，但截至目前，我对 Microsoft 对使用 UserForms 的怪异感到完全失望。这是解决问题的方法：

I had not yet set the tab order!

我还没有设置标签顺序！

I realized the tab order had my form opening with the first tab stop being set for a TextBox in a MultiPage on my form. I set the tab order so that the first TextBox is active on the UserForm and everything works with the coloring on the main body of the form.

我意识到 Tab 键顺序让我的表单打开，第一个 Tab 停止位被设置为我表单上 MultiPage 中的 TextBox。我设置了选项卡顺序，以便用户窗体上的第一个文本框处于活动状态，并且所有内容都与窗体主体上的颜色一起使用。

Here is where the weirdness begins, in my opinion.

在我看来，这就是奇怪的开始。

When the last TextBox on the main body of the form is reached and tab is pressed, the multi-page itselfis selected. Only after you hit tab a second time is the first TextBox within the MultiPage selected and then the colors are not applied as they are in the main body of the form at all. The same scenario holds true for Frames as well. Also, there does not appear to be a good way to simply tab from the end of page 1 to the beginning of page 2.

当到达表单主体上的最后一个 TextBox 并按下 Tab 键时，多页本身被选中。只有在您第二次点击 Tab 后，MultiPage 中的第一个 TextBox 才会被选中，然后颜色不会像在表单的主体中那样应用。同样的情况也适用于 Frames。此外，从第 1 页的末尾到第 2 页的开头简单地使用 Tab 键似乎也不是一个好方法。

It's very disappointing to me because I would have thought that this is not the way it is. I ASSUMED I could set up 1000 TextBoxes, use the Frames and the Multipage to organize things (SO I COULD MAINTAIN THE WINDOW AT ONE SIZE AND NOT HAVE TO SCROLL THE FORM UP AND DOWN) and then set a tab order that would navigate ALLof the TextBoxes regardless of what organizing container they are in. I assumed it would be this way because it MAKES SENSE! I want to click into the first TextBox and simply never touch my mouse until the form is completely filled out. Otherwise, there really is no point in this effort of making a UserForm! I could point and click around in the spreadsheet without the hassle of designing a form and writing code!

这对我来说非常令人失望，因为我会认为这不是它的方式。我假设我可以设置 1000 个文本框，使用框架和多页来组织事物（所以我可以以一种尺寸维护窗口，而不必上下滚动表单），然后设置一个选项卡顺序，可以浏览所有内容TextBoxes，不管它们在什么组织容器中。我认为它会是这样，因为它有意义！我想点击第一个 TextBox 并且在表单完全填写之前永远不要触摸我的鼠标。否则，制作用户表单的努力真的没有意义！我可以在电子表格中指向和单击，而无需设计表单和编写代码！

What a bummer!

真是太糟糕了！

I suppose I can "make it so!" by writing a bunch of code to jump the selection from container to container...MICROSOFT - It should not be this wonky and stupid!

我想我可以“做到这一点！” 通过编写一堆代码将选择从一个容器跳转到另一个容器...MICROSOFT - 它不应该如此古怪和愚蠢！