One color change code for all ToggleButtons in a Userforms' Multipage - vba

I have around 100 ToggleButtons.
I would like:
If .value = true then
togglebuttons.BackColor = vbRed
Else
= vbGreen
I can write the code for every one, but is there a way to create a group or class so that color change code would be applied to all of them?
-Excel365

Here's an example that creates a new class in order to handle multiple toggle buttons using one event handler. Note that it assumes that the first page of your multipage control contains your toggle buttons. Change the page reference accordingly.
First insert a new class module (Insert >> Class Module), and name it clsToggleButton.
Then copy and paste the following code into the code module for your new class . . .
Option Explicit
Public WithEvents toggleButton As MSForms.toggleButton
Private Sub toggleButton_Click()
With toggleButton
If .Value = True Then
.BackColor = vbRed
Else
.BackColor = vbGreen
End If
End With
End Sub
Then copy and paste the following code into your userform code module . . .
Option Explicit
Dim toggleButtonCollection As Collection
Private Sub UserForm_Initialize()
Set toggleButtonCollection = New Collection
Dim ctrl As MSForms.Control
Dim cToggleButton As clsToggleButton
For Each ctrl In Me.MultiPage1.Pages(0).Controls
If TypeName(ctrl) = "ToggleButton" Then
'ctrl.BackColor = vbGreen 'uncomment to initially set the backcolor to green
Set cToggleButton = New clsToggleButton
Set cToggleButton.toggleButton = ctrl
toggleButtonCollection.Add cToggleButton
End If
Next ctrl
End Sub

I have not worked with VB for many years and it was .net, so, if this solution is incorrect, let me know.
Solution 1: Arrays or Lists
You can create an array or a list containing all your toggle buttons, loop them and perform the operation you need for each of them. This will make sure that the logic above would be implemented exactly once rather than duplicated, yet, you still need to build your collections with the buttons.
Solution 2: A class
You can create a subclass for your toggle buttons and make sure that every toggle button in question will be of that class. And then you can create a static List for the class. In the constructor of each toggle button you append that button to the shared list in the class. And then you can create a shared method that loops the list and performs the logic you need.
P.S. Sorry for not writing code, I no longer remember the syntax of the language.

Related

Event handling class doesn't fire unless I break userform initialization

This is a follow-up to the following question:
Can't set Userform.KeyPreview to true
To recap: the goal is to build a form with some command buttons and a frame containing check boxes. The check boxes are dynamically populated at userform_initialize in the frame so the user can scroll through them. My problem was with keyboard shortcuts. It wasn't possible to brute force write KeyDown handlers for each of the checkboxes because I don't know which ones will exist. Unfortunately, Excel doesn't support KeyPreview so I had to mock up my own version. Thank you to #UGP for giving me promising avenues that seem to work, but not quite...
First, this is my class module called clsReasonPickKP. I create a new instance for each checkbox to listen for KeyDown events:
Option Explicit
Dim WithEvents vChkBx As MSForms.CheckBox
Friend Sub initializeListener(cControl As control)
Set vChkBx = cControl
End Sub
Private Sub vChkBx_KeyDown(ByVal keyCode As MSForms.ReturnInteger, ByVal shift As Integer)
frm2.keyChooser keyCode
End Sub
The line frm2.keyChooser keyCode launches a quick sub located in the userform code module. Code below:
Public Sub keyChooser(ByVal keyCode As MSForms.ReturnInteger)
Select Case keyCode
Case vbKeyEscape: cancelBtn_Click
Case vbKeyReturn: completeDecision_Click
Case vbKeyN: customizeNote_Click
Case vbKeyS: resetDecisionNote_Click
Case vbKeyR: chkRefGrnds_Click
End Select
End Sub
I've copied the relevant part of the UserForm_Initialize sub below. The loop creates the checkboxes and an event listener for each.
Sub UserForm_Initialize()
Dim x As Long, maxWidth as Long
Dim cControl As control
Dim keyPreviewCollection As New Collection
Dim keyPreviewer As clsReasonPickKP
For x = 1 To dTbl.Rows.Count - 1
Set cControl = chkBoxFrame.Controls.Add("Forms.CheckBox.1", "chkBox" & x, True)
With cControl
.AutoSize = True
.WordWrap = False
.Left = 10
.Top = 16 * x - 12
.Caption = dTbl(x, 1).Value
If .Width > maxWidth Then maxWidth = .Width
End With
Set keyPreviewer = New clsReasonPickKP
keyPreviewer.initializeListener cControl
keyPreviewCollection.Add keyPreviewer
Next x
'Additional initialization code here
End Sub
The odd thing is that unless I break code some time after keyPreviewCollection.Add keyPreviewer, the listener doesn't seem to handle the event. For example, if I set a break point at Next x or for x > 1 and then complete initialization, then when the form is finished initializing and appears the listener calls keyChooser and all is well; if I don't break code like that, it doesn't trap the event or call the sub, etc.
To trouble-shoot, I've tried not adding keyPreviewer to the collection, and then the listener also doesn't work, no matter if or when I break. It seems adding the object to the collection, and being in code break mode after adding it to the collection, somehow makes the listener trap the event.
Also interesting, if I put a breakpoint in the vChkBx_KeyDown module, it breaks when the event is raised (assuming an appropriate break as described above). After I then run the code, however, it stops handling the KeyDown event when its raised.
In case it helps, I'm currently working in Excel 2010.
Does anybody have any idea what's going on? Any idea how to solve this, even with a different code approach?
Thank you as always for everybody's help.
It turns out that the problem was so simple and right in front of my eyes. I just had to make the keyPreviewer and keyPreviewCollection variables public in my userform code module.
That still doesn't answer why breaking code execution after adding the object to the collection made VBA treat it as public, but just happy that it all works.
DoEvents might be the ticket. See the article below:
https://www.automateexcel.com/vba/doevents/

MS Access 2013, Subform operations destroy the class module

I have a form in my Access project called MainForm, there is a sub form called subForm, also many buttons on the MainForm, at the same time, I created a class module to handle the OnClick event for all the buttons and the module name is classButtons.
Code in the class module:
Public WithEvents cButtons as Access.CommandButton
Dim tmpValue as String
Private Sub cButtons_Click()
Select Case cButton.Name
Case "ButtonA"
MainForm.subForm.Requery
Case "ButtonB"
Let tmpValue = subForm.ComboBox1.Value
DoCmd.RunSQL "update sometable set somefield='" & tmpValue & "'"
Case "ButtonC"
DoCmd.RunCommand acCmdUnhideColumns
End Select
End Sub
In the Open event of the MainForm, I have the following code:
For i = 0 to Me.Controls.Count - 1
If Left(Me.Controls(i).Name,6) = "cmdbtn" Then
set btnClass = New classButtons
set btnClass.cButtons = Me.Controls(i)
btnClass.cButtons.OnClick = "[Event Procedure]"
mdPublic.buttonColl.Add btnClass 'buttonColl is a collection variable declared in another module called "mdPublic"
End If
Next
Then once the MainForm is opened, all the 3 buttons works well, but once ButtonA or ButtonB is clicked, all the 3 buttons will stop working.
I tried to remove the subForm operations from ButtonA and ButtonB, and found that the problem is disappeared, so I guess the subForm operations just "destroy" the class module.
But I do need those operations, anyone has any ideas? Thank you !!!!!
What I do is make a function behind the form to handle the button behaviors, call it HandleButtonClick(x As String), then in each button Click event property:
=HandleButtonClick("ButtonA") -- change the button designation as appropriate
Also, I always name a subform container different from the subform it holds, such as ctrDetails. Code behind main form must reference the subform container name.

Problems when calling a public sub

I'm facing a deadend When trying to call this sub :
Public Sub backblue(ByVal frm As Form, ByVal boxname As String)
For i = 1 To 3
CType(frm.Controls(boxname & i.ToString()), TextBox).BackColor = Color.LightBlue
Next
End Sub
with button click event :
Private Sub Button1_click and bla bla....
backblue(Me, "txb1_")
End Sub
Can anybody show me a suggestion to fix the code.
It throws "Object Referrence not set to an instance bla bla" error
For information the textbox names are :
txb1_1 , txb1_2 , txb1_3
(these are some of the many textboxes in the form that i want its bakcolor changed)
and these three textboxes are already created through designer, not from execution.
i did check the textboxes names and there's nothing wrong.
the form class is also public.
if they are the only textboxs on said form you can just loop through
For Each box as Textbox In frm.Controls
box.BackColor = Color.LightBlue
Next
This error will occur if you do not declare the Form class to be public.
Also, make sure the textbox names are really correct, although this will probably cause a different error.
If you create the textboxes during execution, make sure they are initialized with New and added to the form's Controls collection.
Try this....
Public Sub backblue(ByVal frm As Form, ByVal prefix As String)
For i = 1 To 3
Dim bxName as String = prefix & i.ToString()
Dim bx as TextBox = CType(frm.Controls(bxName), TextBox)
If bx Is Nothing Then
MsgBox("Unable to find text box " +bxName)
Dim mtch() As Control = frm.Controls.Find(bxName, true)
If mtch.Length> 0 then
bx = mtch(0)
Else
Continue For
End if
End If
Bx.BackColor = Color.LightBlue
Next
End Sub
Although, a better solution would be to either create the textboxes inside a control and pass that control to BackBlue or to create an collection that has the controls and pass that in. Which brings up what is most likely yor problem your control is contained in a sub component and thus is not in the main form control collection
Alternative, you could use either the tag of the control or create a component control that implements IExtenderProvider and add it to the form --all of the above would effectively allow you to define the controls and/how they should be handled at designtime.
It may really seem that the names generated by this loop may not be the names of the original textboxes. My suggestion is before setting this Color property verify that the names generated by this loop are indeed the actual names. Maybe output this in a messagebox:
MessageBox.Show(boxname & i.ToString()) for each loop before you set the property

How to access to the properties of an UserControl from code side?

make my own UserControl and I can aggregate new TabPages to a TabControl and then, inside of then TabPage, I add my own UserControl using the following code.
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim TabX As New Windows.Forms.TabPage("Tab " & TabCount.ToString) '(ConfiguracionTabPage)
Dim MyControl As New ClientesEmpresa
MyControl.Name = "Control" & TabCount.ToString
If ClientesTabControl.TabPages.Count = 10 Then
ClientesTabControl.TabPages.RemoveAt(9)
End If
TabX.Controls.Add(MyControl)
TabX.Name = "Tab" & TabCount.ToString
TabX.Text = "Tab" & TabCount.ToString
MyControl.TitularLbl.Text = "Coca Cola"
Me.ClientesTabControl.TabPages.Insert(0, TabX)
Me.ClientesTabControl.SelectedIndex = 0
TabCount += 1
End Sub
My user control have several Labels, TextBox and TabPages(inside of a TabControl).
Now I want to change some properties dynamically from the source code, but I don't know how to access them.
The most similar theme that I found is this How to Acces of an User control in c#, but, as the title says, is in C#, how I can do it in VB.NET?
Sorry, I just notice that the Enter key post the comment. :(
Thanks for your feedback, I understand what are you saying but I missing something in the middle.
When I create the control in running time in the above code I can access easily to the properties of the created object, in this case my UserControl, but I don't understand how to reach the properties of a particular instance of that control from outside of Button_Click; ie. another button_click event(second button)
I was thinking to use something like
Dim ControlList As Windows.Forms.Control() = Me.ClientesTabControl.TabPages(0).Controls.Find("ModeloLbl", True)
or
ClientesTabControl.TabPages(0).Controls.OfType(Of AlarmasVehiculo)()
But I'm stuck here.
------------------------------------- 3th post ---------------
Thanks Steve, I was resolved using "Control.Find" and a For Each but your solution is easier.
There's any way to get the name of the selected tab or I must to create an Array when I create the New TabPage?, the idea is to update the text of the controls inside of the selected tab only when is selected by the user or every 5 seconds but just the in selected one.
Thanks.
To borrow M4N's answer from the C# question, and translate it to VB:
Cleanest way is to expose the desired properties as properties of your usercontrol, e.g:
Public Class MyUserControl
' expose the Text of the richtext control (read-only)
Public ReadOnly Property TextOfRichTextBox As String
Get
Return richTextBox.Text
End Get
End Property
' expose the Checked Property of a checkbox (read/write)
Public Property CheckBoxProperty As Boolean
Get
Return checkBox.Checked
End Get
Set (value As Boolean)
checkBox.Checked = value
End Set
End Property
'...
End Class
In this way you can control which properties you want to expose and whether they should be read/write or read-only. (of course you should use better names for the properties, depending on their meaning).
Another advantage of this approach is that it hides the internal implementation of your user control. Should you ever want to exchange your richtext control with a different one, you won't break the callers/users of your control.
To answer your second question, if you need to access your dynamically created controls, you can do so easily using their names, for instance:
Dim c As ClientesEmpresa= CType(Me.ClientesTabControl.TabPages("Tab1").Controls("Control1"), ClientesEmpresa)
c.CheckBoxProperty = True

Add an event handler to each control on a form at runtime VB6

I have a VB6 application where I'd like to have a consistent behavior among its controls application-wide. One of the behaviors, for example, would be highlighting a text box when it gains focus and removing the highlight when it loses focus. I'd like this to happen on every form.
What I'm trying to do is have one sub procedure that can be called by all forms when they load that will make this behavior happen. That way, I don't have to manually code for each individual text box to make it highlight.
I've tried getting VB6 to attach an event handler to a control at runtime but it just barks at me. I come from a .Net background so maybe I'm approaching it wrong for VB6. But how can I get this desired behavior without having to manually code it for every control?
You could also "Subclass" Your TextBox Controls Using WithEvents. The advantage here is that you can code the highlighting and de-highlighting in one place without having to go through and replace all of your existing controls (as Scott suggests).
The downside is that you have to add code to the Form_Load event of all your forms to "register" the controls on that form. However, even this should not be too bad if you want to apply the technique to every control; in that case, you just need to write a function that loops through the .Controls collection of a form and registers each control. Then just call this function in each form's Form_Load event.
Check this out:
Control Arrays for Visual Basic 6.0 Users
Another way to achieve the behaviour you want is not to handle the textbox events at all. Instead, set up a Timer control with a small tick interval, say 50 milliseconds. In the Tick event, check Me.ActiveControl to see whether the focus has moved, and highlight/dehighlight accordingly. You will need a static variable to remember which control has the focus.
This is a nice easy way to get a universal GotFocus / LostFocus event handler in VB6.
Unfortunately VB6 does not support implementation inheritance and you can't inherit TextBox and just modify or add functionality. It does not support COM aggregation too, though I doubt ActiveX controls specification supports it too.
What you are left with is reimplementing a control from scratch or implementing a custom UserControl that contains the original one and forwards every method, property or event. The problem with the latter approach is not that it's lots of pointless code but the performance of VB6's custom user controls. Built-in controls are really fast and you can place hundreds of labels or textboxes before noticing degradation.
What I'm doing in cases like yours is to implement an extender class that holds a reference to the textbox control, subclasses it and/or listens and responds to raised events from the control. The extender class implements the desired/modified behavior on GetFocus event or WM_GETFOCUS, whatever. Next, for each textbox on the form an instance of the extender is initialized with a reference to the control. All the extenders are held in a collection which can be part of a class that extends the form itself. The form extender can wrap the instantiation and initialization of the control extenders (the For Each In Controls part).
I'm doing this constantly, having very rich extenders for every possible control I'm placing on forms that wrap every property/method I'm accessing. I'm listening for events only on the extenders too. The nice part is that when I find a bug in a 3rd party control I can mitigate it very easily in the control extender.
I am with the Extender idea myself thanks to the tip from this site I have come up with my own solution:
Class clsTextBoxExtender Defintion:
Public WithEvents Control As TextBox
Private Sub Control_GotFocus()
Control.SelStart = 0
Control.SelLength = Len(Control.Text)
End Sub
Private Sub Control_LostFocus()
Control.SelLength = 0
End Sub
Module Module1 Defintion:
Public Sub InitialiseTextBoxExtenders(ByRef myForm As Form, ByRef extenderCollection As Collection)
Dim formControl As Control
Dim oTBXExtender As clsTextBoxExtender
For Each formControl In myForm.Controls
If TypeOf formControl Is TextBox Then
Set oTBXExtender = New clsTextBoxExtender
Set oTBXExtender.Control = formControl
extenderCollection.Add oTBXExtender
End If
Next
End Sub
Form Form1 Definition:
Private textBoxExtenderCollection As New Collection
Private Sub Form1_Load()
Module1.InitialiseTextBoxExtenders Me, textBoxExtenderCollection
End Sub
'No longer required
'Private Sub TextBox1_GotFocus()
' TextBox1.SelStart = 0
' TextBox1.SelLength = Len(TextBox1.Text)
'End Sub
So in effect for every new form all you have to do is declare a collection and call the initialiser code in the form load event. Simple!
Furthermore if you have further requirements that you need to refer back to you extender class rather than looping thru your collection you may choose to create a Key of say the control's name when adding to the collection however keep in mind if you are using control arrays on your form your form may need to include the Index in the key.
Also note if you declare the same event in your form for your control both your event and the extender event will fire one after the other. I do not know of any documentation on this however, from my experimentation the extender event goes last.
The appropriate way to do what you're asking is to define a new UserControl (MyAdvancedTextBox) and code your intended behavior in there. Then replace all of your text boxes with that user control. It's a lot of work, but it's less work than the alternative:
Manually define an event handler in the code-behind for each text box (or text box control array) and have the event handler pass itself to some common module subroutine that executes your common handling logic.
VB6 events are a lot more primitive than .NET.
The tips are good. However, the example shared is very limited.
I have an issue with the events for dynamic controls.
i have to create check box , text box , radio buttons and Combo box on click of a button. I am able to successfully create the dynamic controls.
BUT i am not able to capture the actions of each of this control, such change status of check box or radio options or changes in Dropdown text...
Adding the code for reference:
Expectation:
1. I should be able to capture delete Row change in the check box
2. I should be able to capture changes in Combo box
Static Controls:
1. Form: frmcharacteristics
2. Button: cmdAddCharacteristics
3. SSTab: tabDisplay
Code in Module1:
Public SR_NO As Long
Public Top_Position As Long
code in frmCharacterisitcs
Option Explicit
Dim WithEvents Ch_Delete_Row As CheckBox
Dim WithEvents Ch_SR_NO As Label
Dim WithEvents Ch_Name As TextBox
Dim WithEvents Ch_Type As ComboBox
Dim WithEvents Extended_Control As VBControlExtender
Private Sub cmdAddCharacteristics_Click()
Module1.SR_NO = Module1.SR_NO + 1
Set Ch_Delete_Row = frmCharacteristics.Controls.Add("VB.CheckBox", "Ch_Delete_Row" & (Module1.SR_NO), tabDisplay)
Ch_Delete_Row.Visible = True
Ch_Delete_Row.Top = Module1.Top_Position + 100
Ch_Delete_Row.Width = 1000
Ch_Delete_Row.Left = 500
Ch_Delete_Row.Caption = ""
Ch_Delete_Row.Height = 315
'MsgBox Ch_Delete_Row.Name
Set Ch_SR_NO = frmCharacteristics.Controls.Add("VB.Label", "Ch_SR_NO" & (Module1.SR_NO), tabDisplay)
Ch_SR_NO.Visible = True
Ch_SR_NO.Top = Module1.Top_Position + 200
Ch_SR_NO.Width = 750
Ch_SR_NO.Left = Ch_Delete_Row.Left + Ch_Delete_Row.Width + 400
Ch_SR_NO.Caption = Module1.SR_NO
Ch_SR_NO.Height = 315
Set Ch_Name = frmCharacteristics.Controls.Add("VB.TextBox", "Ch_Name" & (Module1.SR_NO), tabDisplay)
Ch_Name.Visible = True
Ch_Name.Top = Module1.Top_Position + 100
Ch_Name.Width = 2000
Ch_Name.Left = Ch_SR_NO.Left + Ch_SR_NO.Width + 200
Ch_Name.Text = ""
Ch_Name.Height = 315
Set Ch_Type = frmCharacteristics.Controls.Add("VB.ComboBox", "Ch_Type" & (Module1.SR_NO), tabDisplay)
Ch_Type.Visible = True
Ch_Type.Top = Module1.Top_Position + 100
Ch_Type.Width = 1500
Ch_Type.Left = Ch_Name.Left + Ch_Name.Width + 50
Ch_Type.Text = ""
'Ch_Type.Height = 315
Ch_Type.AddItem "Service"
Ch_Type.AddItem "Special"
Ch_Type.AddItem "Option"
Module1.Top_Position = Module1.Top_Position + 400
End Sub
Private Sub Form_Load()
Module1.SR_NO = 0
Dim Test_Line As Control
Set Test_Line = frmCharacteristics.Controls.Add("VB.Line", "LINE", frmCharacteristics)
Test_Line.Visible = True
Test_Line.X1 = 100
Test_Line.Y1 = 600
Test_Line.X2 = frmCharacteristics.Width
Test_Line.Y2 = 600
Top_Position = Test_Line.Y1
frmCharacteristics.Show
tabDisplay.Width = frmCharacteristics.Width - 1000
tabDisplay.Height = frmCharacteristics.Height - 1500
tabDisplay.Left = frmCharacteristics.Left + 200
Call set_labels
End Sub
Sub set_labels()
Dim Label_SR_NO As Control
Dim Label_Name As Control
Dim Label_Delete_Row As Control
Dim Label_Type As Control
Set Label_Delete_Row = frmCharacteristics.Controls.Add("VB.Label", "Label_Delete_Row" & (Module1.SR_NO), tabDisplay)
Label_Delete_Row.Visible = True
Label_Delete_Row.Top = Module1.Top_Position + 100
Label_Delete_Row.Width = 1000
Label_Delete_Row.Left = 300
Label_Delete_Row.Caption = "Delete(Y/N)"
Label_Delete_Row.Height = 315
Set Label_SR_NO = frmCharacteristics.Controls.Add("VB.Label", "Label_SR_NO" & (Module1.SR_NO), tabDisplay)
Label_SR_NO.Visible = True
Label_SR_NO.Top = Module1.Top_Position + 100
Label_SR_NO.Width = 750
Label_SR_NO.Left = Label_Delete_Row.Left + Label_Delete_Row.Width + 400
Label_SR_NO.Caption = "SR_NO"
Label_SR_NO.Height = 315
Set Label_Name = frmCharacteristics.Controls.Add("VB.Label", "Label_Name" & (Module1.SR_NO), tabDisplay)
Label_Name.Visible = True
Label_Name.Top = Module1.Top_Position + 100
Label_Name.Width = 2000
Label_Name.Left = Label_SR_NO.Left + Label_SR_NO.Width + 400
Label_Name.Caption = "Characteristics Name"
Label_Name.Height = 315
Set Label_Type = frmCharacteristics.Controls.Add("VB.Label", "Label_Type" & (Module1.SR_NO), tabDisplay)
Label_Type.Visible = True
Label_Type.Top = Module1.Top_Position + 100
Label_Type.Width = 1500
Label_Type.Left = Label_Name.Left + Label_Name.Width + 50
Label_Type.Caption = "Charac. Type"
Label_Type.Height = 315
Module1.Top_Position = Module1.Top_Position + 400
End Sub