My code loops through all of the existing OLEObjects within the current sheet in an Excel workbook. I want it to find a specific one (based on the name passed to the sub) which is always a CheckBox and assign it to a variable of type CheckBox.
Note: The other objects are not all Checkboxes, hence the generic OLEObject type.
Example code that calls sub, showing example of name:
HandleCheckBoxClick("chkAddSummary")
Sub that looks for this specific object:
Sub HandleCheckBoxClick(nm As String)
Dim o As OLEObject
Dim cb As CheckBox
For Each o In Me.OLEObjects
If o.name = nm Then
Set cb = o
End If
Next o
End Sub
I found a very similar question at: Excel VBA: how to cast a generic control object into a ComboBox object? but it refers to Form Controls (not ActiveX Controls). I tried the method given in the answer to see whether it was transferrable between the two control types but had no success.
The reason I want to do this is similar to the asker of the question I refer to - I cannot use methods like CheckBox.Value with a generic OLEObject variable.
I have also tried using the OLEObject.progID method to make sure o is a checkbox object. The error I get when trying to Set cb = o is a Type Mismatch.
When declared as MSForms.CheckBox it then should be possible to assign o.Object.
Sub test()
HandleCheckBoxClick "chkAddSummary"
End Sub
Sub HandleCheckBoxClick(nm As String)
Dim o As OLEObject
Dim CB As MSForms.CheckBox
For Each o In Me.OLEObjects
If o.Name = nm Then
Set CB = o.Object
End If
Next o
End Sub
I couldn't find (so far) how to assign it to a CheckBox, I found how to assign it to a OLEObject variable (if that helps you).
Sub HandleCheckBoxClick(nm As String)
Dim o As OLEObject
Dim CB As CheckBox
Dim oleObj As OLEObject
' loop though all OLEObjects in "Sheet2" >> modify to your sheet name
For Each o In Sheets("Sheet2").OLEObjects
If TypeName(o.Object) = "CheckBox" Then
Debug.Print o.Name
' if you have more then 1 CheckBox
If o.Name = nm Then
Set oleObj = o
' Set CB = o.Select
End If
End If
Next o
' just to test the options with OLEObject variable
With t
t.Top = 100
If t.Object.Value = True Then
MsgBox "CheckBoX " & nm & " is selected"
Else
MsgBox "CheckBoX " & nm & " is not selected"
End If
End With
End Sub
This worked for me to get the checkbox state
Dim checkBox1 As Object
Set checkBox1 = Sheet1.OLEObjects("CheckBox1").Object
MsgBox checkBox1.Value
Related
So I have this spreadsheet with several listboxes. In these listboxes I have some values/items that are actually filters. I want to get each item/filter of each listboxes to amend an SQL query in my code.
So I've been asked to looped through the listboxes and I managed to do it by looping the Shapes of the spreadsheet but eventually ... those listboxes are now viewed as Shapes in VBA and not listboxes anymore. I'm looking for a way to either turn my shape in listbox or maybe find a method from the Shapes type to loop each listbox's items. Here is the part of my code, so far I loop through each shapes/listboxes, if within my shapes'name there is the word "CFRA" then I want to loop within each item selected of my listbox so that my function return them.
Private Function getListFilters() As String
My_Sheet.Activate
Dim Shp
For Each Shp In My_Sheet.Shapes
pos = InStrRev(Shp.Name, "CFRA", , vbTextCompare)
MsgBox (pos)
If pos <> 0 Then
MsgBox (TypeName(Shp))
End If
Next
End Function
Thanks in advance for those who are willing to help me and have a great day :)
Since you do not explain what is to be extracted from the list box, try the next Function, please. It will deliver the list box object having "CFRA" string in its name. Of course, any string can be used:
Private Function getListObjX(strPartName As String, sh As Worksheet) As MSForms.ListBox
Dim oObj As OLEObject
For Each oObj In sh.OLEObjects
If oObj.Name Like "*" & strPartName & "*" Then
'Debug.Print oObj.Name, TypeName(oObj.Object): Stop
If TypeName(oObj.Object) = "ListBox" Then
Set getListObjX = oObj.Object: Exit Function
End If
End If
Next
End Function
It can be called in the next way:
Sub testGetListObj()
Dim sh As Worksheet, lstB As MSForms.ListBox, lstBF As ListBox
Dim i As Long, arrSel As Variant, k As Long
Set sh = ActiveSheet
Set lstB = getListObjX("CFRA", sh)
If lstB Is Nothing Then MsgBox "No such an ActiveX list box...": Exit Sub
ReDim arrSel(lstB.ListCount - 1)
For i = 0 To lstB.ListCount - 1
If lstB.Selected(i) Then
'Debug.Print lstB.List(i)
arrSel(k) = lstB.List(i): k = k + 1
End If
Next i
ReDim Preserve arrSel(k - 1)
MsgBox Join(arrSel, "|")
End Sub
But, being an ActiveX list box type, you can simply use one of its events. Of course, if you do not need to take items from more then a list box...
I also prepared a function to return the object for a Form list box (before you clarify the issue). Maybe, somebody else will use it...
Dim oObj As ListBox
For Each oObj In sh.ListBoxes 'even not being shown by intellisense, this collection exists...
If oObj.Name Like "*" & strPartName & "*" Then
'Debug.Print oObj.Name
Set getListObjF = oObj: Exit Function
End If
Next
End Function
It can be called similarly, but the lstB should be declared As ListBox.
Edited, to make the function working in one step:
Private Function getListFilters(strPartName) As String
Dim sh As Worksheet, lstB As MSForms.ListBox
Dim oObj As OLEObject, i As Long, arrSel As Variant, k As Long
Set sh = ActiveSheet ' use here your sheet
For Each oObj In sh.OLEObjects
If oObj.Name Like "*" & strPartName & "*" Then
If TypeName(oObj.Object) = "ListBox" Then
Set lstB = oObj.Object: Exit For
End If
End If
Next
If lstB Is Nothing Then MsgBox "No such an ActiveX list box...": Exit Function
ReDim arrSel(lstB.ListCount - 1)
For i = 0 To lstB.ListCount - 1
If lstB.Selected(i) Then
arrSel(k) = lstB.List(i): k = k + 1
End If
Next i
ReDim Preserve arrSel(k - 1)
getListFilters = Join(arrSel, "|")
End Function
And the function will be simple called as:
Debug.Print getListFilters("CFRA")
You access ActiveX-Objects via the OLEObjects-Collection of a worksheet. The interesting control information are in the property Object of such an object:
Use VBA function TypeName to figure out what kind of OLE object you have
Number of items can be fetched with the Object.ListCount property.
To access the items of a listbox, loop over the Object.list property (index starts at 0, so loop must run from 0 to ListCount-1)
To check if an item is selected, use the matching .Object.Selected property.
The following code will loop will print all selected items of all listboxes of a worksheet:
Sub listBoxes()
Dim objx As OLEObject
For Each objx In ActiveSheet.OLEObjects
Debug.Print "Name = " & objx.Name & " Typ = " & TypeName(objx.Object)
If TypeName(objx.Object) = "ListBox" Then
Dim i As Long
For i = 0 To objx.Object.ListCount - 1
If objx.Object.Selected(i) Then
Debug.Print objx.Name, objx.Object.list(i)
End If
Next i
End If
Next
End Sub
Update: To show the coherence between Shapes, OleObjects and ActiceX controls on a sheet:
A Shape is a container for everything that is not part of a cell/range. Could be any kind of painted shape forms (rectangels, arrows, stars...), could be an image, a chart, an OLEObject, a form control and so on.
An OLEObject is a something that is not from Excel but is put into an Excel sheet, using a technique called OLE, Object Linking and Embedding.
An ActiveX is a control (editbox, listbox...). These controls where developed by Microsoft and where meant to run in different environments (eg a browser). They are accessible via dll and this dll is added into Excel and other office programs.
Every ActiveX-Control is added as an OLEObject into a sheet, but you can have also different OLEObjects (eg an embedded Word document) that are not an ActiceX objects.
When you want to access those things via VBA, you can use the Shapes-collection that lists all shapes of a sheet (including all OLEObjects), or you can use the OLEObjects-collection that lists all OLEObjects (including all ActiveX controls). However, there is no ActiveX collection, so if you want to fetch all ActiceX-Controls, you have to loop over either the two collections mentioned above.
If you want to access an OLEObject from the shape collection, you first need to check the type of the shape, it must have the type msoOLEControlObject (12) or msoEmbeddedOLEObject (7). A list of all shape types can be found here.
If the shape is either 7 or 12, you can access the OLEObject using Shape.OLEFormat.Object. The following to loops results in exactly the same (ws is just a worksheet variable)
Dim sh As Shape, oleObj As OLEObject
For Each sh In ws.Shapes
If sh.Type = msoOLEControlObject Or sh.Type = msoEmbeddedOLEObject Then
Set oleObj = sh.OLEFormat.Object
Debug.Print oleObj.Name, oleObj.OLEType
End If
Next
For Each oleObj In ws.OLEObjects
Debug.Print oleObj.Name, oleObj.OLEType
Next
Note that sh.Name and sh.OLEFormat.Object.Name are not necessarily the same.
Now the last step is to find the ActiveX-Controls of a specific type, this was already shown in the code of the original answer above - the ActiveX-control can be accessed via oleObj.object. Check the object type if the VBA function TypeName to filter out for example your listboxes.
:)
Im new to VBA!
I have a working code for inserting date where i have a bookmark when using a checkbox (ActiveX). Problem is i have 33 checkboxes (I actually wish for 33x2. one for yes and one for no). So i ended up with 33 Subs and 33 bookmarks. I bet this code can be more efficient braking it down to just a few subs. Annyone has anny idea if it can be done?
The code under is the first of 33 repeating subs where Sub and bookmark name is agi1, agi2 agi3.....
Private Sub agi1_Click()
Dim rngFormat As Range
Set rngFormat = ActiveDocument.Range( _
Start:=ActiveDocument.Bookmarks("agi1").Range.Start, _
End:=ActiveDocument.Bookmarks("agi1").Range.End)
With rngFormat
.Font.Size = 8
End With
Dim v
Dim BMRange As Range
v = ThisDocument.agi1.Value
'Sjekke om boks er sjekket eller ikke
If v = True Then
'Sett inn dato i bokmerke
Set BMRange = ActiveDocument.Bookmarks("agi1").Range
With Selection.Font
.Size = 9
End With
BMRange.Text = (Format(Date, "dd.mm.yyyy"))
Else
'Erstatte dato med tom tekst hvis boks ikke er sjekket
Set BMRange = ActiveDocument.Bookmarks("agi1").Range
BMRange.Text = " "
End If
'Sett inn bokmerke på nytt
ActiveDocument.Bookmarks.Add "agi1", BMRange
End Sub
You could use event sinking, maybe to.
In an normal module, create a collection and populate it to hold the classes that will control the check box events.
In this have the code, this will need to be run on opening the document, something early in it's life to populate the collection.
Public col As Collection
Public Sub SETUP()
Dim o As InlineShape
Dim c As MSForms.CheckBox
Dim cust As clsCustomCheckBox
Set col = New Collection
For Each o In ActiveDocument.InlineShapes
Set c = o.OLEFormat.Object
Set cust = New clsCustomCheckBox
cust.INIT c
col.Add cust
Next o
End Sub
and then have a class module called clsCustomCheckBox and have it's code as
Private WithEvents c As MSForms.CheckBox
Public Function INIT(cmdIN As MSForms.CheckBox)
Set c = cmdIN
End Function
Private Sub c_Click()
MsgBox "Here you can get the name " & c.Name
End Sub
This will divert each checkbox click to the classes c_click rather than it's own.
So for you
Dim rngFormat As Range
Set rngFormat = ActiveDocument.Range( _
Start:=ActiveDocument.Bookmarks(c.name).Range.Start, _
End:=ActiveDocument.Bookmarks(c.name).Range.End)
With rngFormat
.Font.Size = 8
End With
.......
ActiveX controls always register their event handlers like so:
Private Sub NameOfTheControl_NameOfTheEvent({args})
If you rename the handler, the control stops working - because the name of the handler must be formed as above, with an underscore separating the name of the control and the name of the handled event.
So if your controls must exist at compile-time, there's no way around it: for 33 controls you need 33 handlers.
That doesn't mean you need that huge procedure repeated 33 times!
Extract a procedure. Select the entire body of that handler, cut it.
Now make a new procedure prototype:
Private Sub HandleCheckBoxClick(ByVal controlName As String)
End Sub
And paste the body in there. Then replace all the places you have a hard-coded "agi1" with a reference to this controlName parameter:
Dim rngFormat As Range
Set rngFormat = ActiveDocument.Range( _
Start:=ActiveDocument.Bookmarks(controlName).Range.Start, _
End:=ActiveDocument.Bookmarks(controlName).Range.End)
With rngFormat
.Font.Size = 8
End With
'...
The places where you're referring to the control using its programmatic name will be a bit harder:
v = ThisDocument.agi1.Value
You can get the MSForms.CheckBox control through the ThisDocument.InlineShapes collection, but that won't let you find a checkbox by its name, so you need a function that can do it for you:
Private Function FindCheckBoxByName(ByVal controlName As String) As MSForms.CheckBox
Dim sh As InlineShape
For Each sh In ThisDocument.InlineShapes
If TypeOf sh.OLEFormat.Object Is MSForms.CheckBox Then
If sh.OLEFormat.Object.Name = controlName Then
'return the MSForms control:
Set FindControlByName = sh.OLEFormat.Object
End If
End If
Next
And now you can do this:
Dim cb As MSForms.ChecBox
Set cb = FindCheckBoxByName(controlName)
If cb Is Nothing Then
MsgBox "No ActiveX CheckBox control named '" & controlName & "' was found in ThisDocument."
Exit Sub
End If
v = cb.Value
Once all references to the ActiveX control are parameterized, your 33 handlers can now look like this:
Private Sub agi1_Click()
HandleCheckBoxClick "agi1"
End Sub
Private Sub agi2_Click()
HandleCheckBoxClick "agi2"
End Sub
'...
Private Sub agi33_Click()
HandleCheckBoxClick "agi33"
End Sub
Alternatively, you could have the checkboxes created at run-time, and then have their Click event handled in a dedicated class module, but that's a little bit more involved ;-)
I have a table with the following values:
Now, I would like to call the Userform in column H based on the value in column G, but I can't work out how to call the Userform based on the cell value. The error occurs in line
form.Name = wsControls.Cells(loop2, 8).Value
Here is my code:
Sub Check_Scenarios()
Dim wsAbsatz As Worksheet
Dim wsControls As Worksheet
Dim wsData As Worksheet
Dim loop1 As Long
Dim loop2 As Long
Dim lngKW As Long
Dim form As UserForm
Set wsAbsatz = ThisWorkbook.Worksheets("Production")
Set wsData = ThisWorkbook.Worksheets("Data")
Set wsControls = ThisWorkbook.Worksheets("Controls")
lngKW = wsControls.Cells(1, 2).Value + 2
If lngKW = 3 Then
Exit Sub
End If
For loop1 = wsControls.Cells(10, 2).Value To wsControls.Cells(19, 2).Value Step 10
If wsData.Cells(loop1 + 3, lngKW).Value <> "" Then
MsgBox (wsData.Cells(loop1 + 3, lngKW).Value)
For loop2 = 2 To 16
If wsData.Cells(loop1 + 3, lngKW).Value = wsControls.Cells(loop2, 7).Value Then
form.Name = wsControls.Cells(loop2, 8).Value 'error occurs here
form.Show
End If
Next loop2
End If
Next loop1
End Sub
Project:
Many thanks for your help!
You are trying to assign a Name to a blueprint. These are two errors.
You have to initialize your blueprint as something. Like this:
Dim form As New UserForm
Then, most probably your UserForm does not have a property called Name. It is called Caption. Thus it is like this:
Sub TestMe()
Dim uf As New UserForm1 'judging from your screenshot
uf.Caption = "Testing"
uf.Show
End Sub
Disclaimer:
There is a better way to work with UserForms, not abusing the blueprint, although almost every VBA book shows this UserForm.Show method (in fact every single one I have read so far).
If you have the time and the OOP knowledge implement the ideas from here - or from my interpretation of the ideas. There was also a documentation article about it in StackOverflow, but it was deleted with the whole documentation idea.
You don't "call" a userform. You instantiate it, and then you Show it.
UserForm is the "base class" from which all userforms are derived. See there is inheritance in VBA, only not with custom classes.
So you have a UserForm2 class, a UserForm3 class, a UserForm4 class, and so on.
These classes need to be instantiated before they can be used.
Dim theForm As UserForm
Set theForm = New UserForm2
theForm.Show
Set theForm = New UserForm3
theForm.Show
'...
So what you need is a way to parameterize this Set theForm = New ????? part.
And you can't. Because whatever you're going to do, the contents of a cell is going to be a string, and there's no way you can get an instance of a UserForm3 out of a String that says "UserForm3".
Make a factory function that does the translation:
Public Function CreateForm(ByVal formName As String) As UserForm
Select Case formName
Case "UserForm1"
Set CreateForm = New UserForm1
Case "UserForm2"
Set CreateForm = New UserForm2
Case "UserForm3"
Set CreateForm = New UserForm3
'...
End Select
End Function
And then call that function to get your form object:
Set form = CreateForm(wsControls.Cells(loop2, 8).Value)
If Not form Is Nothing Then form.Show
I am using Ms-Access and I created a userform which has a number of Textboxes on it. The boxes are named: Box1, Box2, Box3 ...
I need to loop through all boxes, but I don't know which is the last one. To avoid looping through all userform controls I thought of trying the following:
For i =1 To 20
If Me.Controls("Box" & i).value = MyCondition Then
'do stuff
End If
Next i
This errors at Box6, which is the first box not found. Is there a way to capture this error and exit the loop when it happens.
I know I could use On Error but I 'd rather capture this specific instance with code instead.
Thanks,
George
A Controls collection is a simplified collection of controls (obviously) and share a same order as a placement order of controls.
First of all, even a creatable collection object lacks methods such as Exists or Contains , hence you need a function with error handling to checking/pulling widget from a collection.
Public Function ExistsWidget(ByVal Name As String) As Boolean
On Error Resume Next
ExistsWidget = Not Me.Controls(Name) Is Nothing
On Error GoTo 0
End Function
If you really doesnt like "ask forgiveness not permission" option you can pull entire ordered collection of your textboxes (and/or check existance by name in another loop with similar logic).
Public Function PullBoxes() As Collection
Dim Control As MSForms.Control
Set PullBoxes = New Collection
For Each Control In Me.Controls
If TypeOf Control Is MSForms.TextBox And _
Left(Control.Name, 3) = "Box" Then
Call PullBoxes.Add(Control)
End If
Next
End Function
Since names of widgets are unique - you can return a Dictionary from that function with (Control.Name, Control) pairs inside and able to check existance of widget by name properly w/o an error suppression.
There's a good guide to Dictionary if it's a new information for you.
Anyway, no matter what object you choose, if user (or code) is unable to create more of thoose textboxes - you can convert this Function above to a Static Property Get or just to a Property Get with Static collection inside, so you iterate over all controls only once (e.g. on UserForm_Initialize event)!
Public Property Get Boxes() As Collection
Static PreservedBoxes As Collection
'There's no loop, but call to PullBoxes to reduce duplicate code in answer
If PreservedBoxes Is Nothing Then _
Set PreservedBoxes = PullBoxes
Set Boxes = PreservedBoxes
End Property
After all, the last created TextBox with name Box* will be:
Public Function LastCreatedBox() As MSForms.TextBox
Dim Boxes As Collection
Set Boxes = PullBoxes
With Boxes
If .Count <> 0 Then _
Set LastCreatedBox = Boxes(.Count)
End With
End Function
I think that now things are clearer to you! Cheers!
Note: All code are definitely a bunch of methods/properties of your form, hence all stuff should be placed inside of form module.
Long story short - you cannot do what you want with VBA.
However, there is a good way to go around it - make a boolean formula, that checks whether the object exists, using the On Error. Thus, your code will not be spoiled with it.
Function ControlExists(ControlName As String, FormCheck As Form) As Boolean
Dim strTest As String
On Error Resume Next
strTest = FormCheck(ControlName).Name
ControlExists = (Err.Number = 0)
End Function
Taken from here:http://www.tek-tips.com/viewthread.cfm?qid=1029435
To see the whole code working, check it like this:
Option Explicit
Sub TestMe()
Dim i As Long
For i = 1 To 20
If fnBlnExists("Label" & i, UserForm1) Then
Debug.Print UserForm1.Controls(CStr("Label" & i)).Name & " EXISTS"
Else
Debug.Print "Does Not exist!"
End If
Next i
End Sub
Public Function fnBlnExists(ControlName As String, ByRef FormCheck As UserForm) As Boolean
Dim strTest As String
On Error Resume Next
strTest = FormCheck(ControlName).Name
fnBlnExists = (Err.Number = 0)
End Function
I would suggest testing the existence in another procedure per below: -
Private Sub Command1_Click()
Dim i As Long
i = 1
Do Until Not BoxExists(i)
If Me.Conrtols("Box" & i).Value = MyCondition Then
'Do stuff
End If
i = i + 1
Next
End Sub
Private Function BoxExists(ByVal LngID As Long) As Boolean
Dim Ctrl As Control
On Error GoTo ErrorHandle
Set Ctrl = Me.Controls("BoX" & LngID)
Set Ctrl = Nothing
BoxExists = True
Exit Function
ErrorHandle:
Err.Clear
End Function
In the above, BoxExists only returns true if the box does exists.
You have taken an incorrect approach here.
If you want to limit the loop, you can loop only in the section your controls reside e.g. Detail. You can use the ControlType property to limit controls to TextBox.
Dim ctl As Control
For Each ctl In Me.Detail.Controls
If ctl.ControlType = acTextBox Then
If ctl.Value = MyCondition Then
'do stuff
End If
End If
Next ctl
I believe the loop will be faster than checking if the control name exists through a helper function and an On Error Resume Next.
But this only a personal opinion.
I have an excel form with a large number of checkboxes that are added at runtime. I would like to add a handler to each one of those checkboxes that will run when the value is changed. I know in other versions of Visual Basic I would use AddHandler, but that doesn't work in Excel VBA.
Following an example, I came up with the following code:
'This is in a class module called CheckboxHandler
Public WithEvents cb As MSForms.CheckBox
Private Sub cb_change()
MsgBox ("test")
end sub
And, in my userform, I have this code:
With CreateObject("Scripting.Dictionary")
.....'Unrelated code omitted
'Variable Checkboxes
'Add Handler to checkboxes
Dim colCBHandlers As Collection
Set colCBHandlers = New Collection
Dim objHandler As CheckboxHandler
Dim i As Long
Dim chkBox As MSForms.CheckBox
For i = 1 To .count - 1
Set chkBox = Me.Controls.Add("Forms.Checkbox.1", "Checkbox" & i)
chkBox.Caption = .Keys()(i)
chkBox.VALUE = False
chkBox.Top = (chkBox.Height + 10) * (i - 1) + 55
chkBox.Left = 725
Set objHandler = New CheckboxHandler
Set objHandler.cb = chkBox
colCBHandlers.Add objHandler
Next i
End With
colCBHandlers will go out of scope as soon as the sub which creates the checkboxes exits.
You need to declare that collection as a global (at the module level) so it doesn't get lost once it has been created and populated.