I know similar questions have been asked before like this and this
but I was having issues with initializing the checkbox array object (My VBA is quite rusty).
I have the following code:
Dim chkAdQ(4) As Checkbox
Set chkAdQ(0) = chkAdQ1
Set chkAdQ(1) = chkAdQ2
Set chkAdQ(2) = chkAdQ3
Set chkAdQ(3) = chkAdQ4
where chkAdQ1, chkAdQ2 etc. are ActiveX checkboxes present on the form. On debugging I can see that chkAdQ(4) prompts 'nothing' on the declaration itself and hence the assignment gives a Type mismatch exception.
I also tried by declaring chkAdQ(4) as an Object but to no avail. Any thoughts?
You can add all checkboxes on the worksheet quite nicely with a simple loop
Sub AddCheckBoxesToArray()
Dim chkAdQ As Variant
Dim cb
i = 0
ReDim chkAdQ(i)
For Each cb In Sheet2.OLEObjects
If TypeName(cb.Object) = "CheckBox" Then
If i > 0 Then ReDim Preserve chkAdQ(0 To i)
Set chkAdQ(i) = cb
i = i + 1
End If
Next cb
For Each cb In chkAdQ
Debug.Print cb.Name
Next cb
End Sub
Remove the second loop when using. This is just to prove that they have all been added by printing their names to the Immediate window
Try this
Dim chkAdQ(0 To 3) As Variant
Set chkAdQ(0) = chkAdQ1
Set chkAdQ(1) = chkAdQ2
Set chkAdQ(2) = chkAdQ3
Set chkAdQ(3) = chkAdQ4
Related
I am trying to get the length of user selected lines/splines
This is the code I'm using to have users select their lines:
Dim USel As Selection
Dim USelLB
Dim InputObject(0)
InputObject(0) = "AnyObject"
Set USel = CATIA.ActiveDocument.Selection
Set USelLB = USel
USel.Clear
USelLB.Clear
Linestomeasure = USelLB.SelectElement3(InputObject, "Select objects to list names", True, CATMultiSelTriggWhenUserValidatesSelection, False)
Linestomeasure is a public variable, in the mainsub i've been trying to measure Linestomeasure using the following code:
Dim pd1 As PartDocument
Dim a As Object
Dim c As Reference
a = TrimLines.Item(1)
c = pd1.Part.CreateReferenceFromObject(a)
Dim Mea1 As Measurable
Dim TheSPAWorkbench As SPAWorkbench
Set TheSPAWorkbench = pd1.GetWorkbench("SPAWorkbench")
Set Mea1 = TheSPAWorkbench.GetMeasurable(c)
But when I run the code a = trimLines.Item(1) gets highlighted in the debugger with the error message "Object Required".
Does anyone have an idea on how I can change my code so that I can get the length of the line as a variable that I can work with ? Or just a different way to go about what I'm trying to do?
Edited answer to reflect comment bellow
Looks like you are assigning the wrong type of variable to the USelLB.SelectElement3 and also missunderstanding how it actually works.
The Selection.SelectElement3 returns a String that reflects whether the selection was sucessfull or not.
The Object retrieved from the Selection is inside the Selection.Item(Index)
Your code should be something like this:
Dim PD1 as PartDocument
Dim Sel 'as Selection 'Sometimes it is needed to comment the selection to use the .SelectElement3 method
Dim InputObjType(0)
Dim SelectionResult as string
Dim LineToMeasure as AnyObject
Dim I as Integer
Dim SpaWorkbench as SPAWorkbench
Dim Measurable as Measurable
InputObjType(0) = "AnyObject"
'set PD1 = Catia.ActiveDocument
set Sel = PD1.Selection
Set TheSPAWorkbench = pd1.GetWorkbench("SPAWorkbench")
Sel.Clear
SelectionResult= Sel.SelectElement3(InputObject, "Select objects to list names", True, CATMultiSelTriggWhenUserValidatesSelection, False)
If SelectionResult = "Ok" or SelectionResult = "Normal" then 'Check if user did not cancel the Selection
For i = 1 to Selection.Count
Set LineToMeasure = Sel.Item(i).Value
set Measurable = SpaWorkbench.GetMeasurable(LineToMeasure)
'Measure whatever you need here.
Next
End If
Keep in mind that using the AnyObject type filter may cause the user to select unwanted objects. You shoudl use a more specific filter.
Private Sub FillRow(programCell As Range, storedProgramCell As Range)
Dim counter As Integer
For counter = 3 To 9
Dim cellOffset As Integer
cellOffset = counter - 3
Dim currentStoredCell As Range
Set currentStoredCell = storedProgramCell.Offset(0, cellOffset)
Dim value As String
value = currentStoredCell.value
Dim currentTargetCell As Range
Set currentTargetCell = programCell.Offset(0, cellOffset)
MsgBox currentStoredCell.value 'Works correctly, prints correct value
currentTargetCell.value = value
Next counter
End Sub
The line:
currentTargetCell.value = value
causes the code to stop executing, with no error.
I added the expression to my watch list, then stepped through the routine. The expression was seen as a Boolean:
This makes me think the expression is being viewed as a comparison, and the program abruptly ends since the returned Boolean is not being stored or used anywhere. I wouldn't doubt if I were wrong though.
I'm new to VBA, struggling to debug my program, so please forgive me if this is a petty mistake. I couldn't find any sources online that explains this problem.
Replace your subroutine with following code:
Private Sub FillRow(Dst As Range, Src As Range)
Dim x As Integer
Dim v As Variant
Dim Srcx As Range
Dim Dstx As Range
Debug.Print "FillRow"
Debug.Print Src.Address
Debug.Print Dst.Address
Debug.Print "Loop"
For x = 0 To 6
Debug.Print x
Set Srcx = Src.Offset(0, x)
Debug.Print Srcx.Address
v = Srcx.Value
Debug.Print TypeName(v)
Set Dstx = Dst.Offset(0, x)
Debug.Print Dstx.Address
Dstx.Value = v
Next
Debug.Print "Completed"
End Sub
Run and post in your question Immediate window output.
Value is a reserved word, even if vba does not raise an error on this name, you should not use it. Name it something else. Also, try setting it as a variant.
I have a userform which contains a number of checkboxes from 1 to 100. I have written some very simple code so that when you submit the form it creates a binary string that represents the state of those 100 checkboxes, where 0 is false and 1 is true. The code to do this is here:
Private Sub BusRulesSubmit_Click()
Dim myBinaryString As String
Dim nm As String
Dim c As Control
For busRuleIdx = 1 To 100
nm = "CheckBox" & busRuleIdx
Set c = Controls(nm)
If c.Value = True Then
myBinaryString = myBinaryString & "1"
Else
myBinaryString = myBinaryString & "0"
End If
Next
msgBox myBinaryString
End Sub
I now want to open this Userform from another form, where I have a similar binary string, and use this string to set the values of the checkboxes to true or false as appropariate. However I am having issues when setting my control. The code is here:
Private Sub populateBusRules()
Dim c As Control
Dim myBRBinary As String
myBRBinary = "000000000011100000000000000000000000000000000000000000000000000000000010000000000000000000000000000"
For busRuleIdx = 1 To 100
nm = "BusinessRules.CheckBox" & busRuleIdx
Set c = Controls(nm)
If Mid(myBRBinary, buRuleIdx - 1, 1) = 1 Then
c.Value = True
Else
c.Value = False
End If
Next
End Sub
When I run the above, I get a runtime error "Could not find the specified object" and when going to debug it highlights this problem where the code states "Set c = Controls(nm)" - and I can see that it is failing in the first round of the loop i.e. where nm = "BusinessRules.CheckBox1"
Interestingly if I run the code "Set c = Controls(BusinessRules.CheckBox1)" I get no such issue.
Any help would be much appreciated.
Thanks,
Paul.
I think the BusinessRules is giving you the issue. In the Controls collection, there is no Control named "BusinessRules.CheckBox1", only one named "CheckBox1" within the BusinessRules.Controls collection. Assuming there aren't other issues mentioned in the comments above (like the form being closed before this is called), then this should fix your issue
I've got several check boxes to which I am going to change the visibility and caption of based on the index of a for loop. I have an array of 1 to X. Into my form I am passing along the array total and each array element is a string.
Anyway, on my worksheet I am passing:
Sub Stripdown_Button_Click()
LastUpdateColumn = Sheets("Update").UsedRange.Columns.Count
Header_Array = Range(Cells(7, 1), Cells(7, LastUpdateColumn)).Value
Header_Form.Header_Select LastUpdateColumn, Header_Array()
Header_Form.Show
End Sub
LastUpdateColumn will be an integer, Header_Array will be an array of strings.
My form, which I am probably completely screwing up at this point is as follows...
Public Sub Header_Select(Index As Integer, Header_List() As String)
For x = 1 To Index
If Header_List(1) <> "" Then
cb & Index.Visible = True
cb & Index.Caption = Header_List(Index)
Else
MsgBox "Form Error. Contact Engineering", vbOKOnly
On Error Resume Next
End Sub
You cannot create a variable name from a string; however the forms have a Controls default property accepting a control name as index
Dim cb As CheckBox
Set cb = Controls("cb" & Index)
cb.Visible = True
cb.Caption = Header_List(Index)
Since the property is the default property, this other syntax also works:
Set cb = Me("cb" & Index)
I'm still learning VBA and I can't figure out wth I'm having so many problems with a Collections object.
I have a function that adds custom objects (I created a very simple class to store some data) that does the typical "read data, create object representation, stick it into Collections" sort of stuff.
If I try to add a "key" to the bag.add call I get a "Compile error. Expected:=" message.
If I don't it appears to have worked then when I run the program it says "Compile Error. Argument not optional" and highlights the "getRevColumns = bag" line.
I can't for the life of me figure out wth is going on! I suspect something wrong with how I initialized my bag?! PS: columnMap is the name of my custom class.
Function getRevColumns() As Collection
Dim rng As Range
Dim i As Integer
Dim bag As Collection
Dim opManCol As Integer, siebelCol As Integer
Dim opManColName As String, siebelColName As String
Dim itm As columnMap
Set bag = New Collection
Set rng = shSiebelMap.UsedRange.Columns(5)
i = 1
For i = 1 To rng.Rows.count
If StrComp(UCase(rng.Cells(i).value), "Y") = 0 Then
opManCol = rng.Rows(i).OffSet(0, -2).value
opManColName = rng.Rows(i).OffSet(0, -4)
siebelCol = rng.Rows(i).OffSet(0, -1).value
siebelColName = rng.Rows(i).OffSet(0, -3)
Set itm = New columnMap
itm.opManColName = opManColName
itm.opManColNumber = opManCol
itm.siebelColName = siebelColName
itm.siebelColNumber = siebelCol
'WHY DOESN'T IT WORK!''
bag.Add (itm)
'MsgBox "opMan Col: " & opManColName & " : " & opManCol & ". Siebel Col: " & siebelColName & " : " & siebelCol'
End If
Next i
getRevColumns = bag
End Function
Try removing the parens around itm in the add:
bag.Add itm
or
bag.Add itm, key
It's been a while since I've had to work with VBA/VB6, but I believe including the parens causes itm to be passed by value instead of by reference. I could be wrong.
the bag is an object. Rule #1 for objects use Set
Set getRevColumns = bag
You need to say
set getRevColumns = bag
also I guess you have a problem on the add. I don't know why this is but it works on
bag.add itm
I tried the whole thing in a simple manner here is my working code
Sub myroutine()
Dim bag As Collection
Dim itm As clsSimple
Set bag = getTheCollection()
Set itm = bag.Item(1)
MsgBox (itm.someObjectValue)
Set itm = bag.Item(2)
MsgBox (itm.someObjectValue)
End Sub
Function getTheCollection() As Collection
Dim bag As Collection
Dim itm As clsSimple
Set bag = New Collection
Set itm = New clsSimple
itm.someObjectValue = "value 1"
bag.Add itm
Set itm = New clsSimple
itm.someObjectValue = "value 2"
bag.Add itm
Set getTheCollection = bag
End Function
The class is really simple:
Public someObjectValue As String
Hope it helps
I had a similar problem with a collection.
I Dim'd it but hadn't set it with New or initialized it.
Basically i had
Dim collection1 As Collection
...
collection1.Add item 'no compile error just empty
I added the following before the add
Set collection1 = New Collection
Call collection1.init
then it worked like a charm...I had also moved the Dim statement from the Sub to the top of the Module to make it a class variable