Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

AddIn to Select Controls By Name

5 views
Skip to first unread message

Aoli

unread,
Mar 21, 2022, 1:39:26 PM3/21/22
to
Here is what I have so far and it all works except for being able to
select one or more controls. Adding this to an existing fully
functional Addin of mine.

See NOTE: in code below.

Private Sub SelectControls()

On Error Resume Next

Dim oCtrl As VBControl
Dim sFName As String

Dim sSelect As String
Dim asName() As String
Dim lX As Long

NOTE: using variant because I do not know the type. Do You ?
Dim cmpCurrent

sSelect = InputBox("Use | To Separate Control Names")

If LenB(sSelect) > 0 Then

Set cmpCurrent = VBInstance.SelectedVBComponent

asName() = Split(UCase$(sSelect), "|")

sFName = VBInstance.SelectedVBComponent.Name

Set cmpCurrent = VBInstance.SelectedVBComponent

For lX = 0 To UBound(asName)
Debug.Print "asName()", asName(lX)
For Each oCtrl In cmpCurrent.Designer.VBControls

Debug.Print "oCtrl.Properties!Name", oCtrl.Properties!Name
If UCase$(oCtrl.Properties!Name) = asName(lX) Then

Debug.Print oCtrl.Container.Parent.Properties("Name")

NOTE: here I want to select this oCtrl, then other controls
oCtrl.Properties!Item = True ' NOT CORRECT, HELP !
If Err Then
Debug.Print "Not Right " & Err.Description
Err = 0
End If

End If
Next oCtrl
Next lX
End If

End Sub

Aoli

unread,
Mar 21, 2022, 5:08:45 PM3/21/22
to
It took a few hours and a lot of reading but here is the addin code that
seems to do what I want.

I just got sting by the coding bug and this is my scratchings.

yes, it has a few extras that do nothing but I was trying out different
stuff and possibly in the future the other stuff might be of interest.

I can specify one or more controls to select using '|'.
I can specify as general cmdWOW and if indexed all cmdWow() will be
selected. Or specify specific cmdWOW(2)|cmdWOW(4)
I can specify an ambiguous control name. cmdW?W with or without index
if applicable. Also * is supported. Using 'Like' not case sensitive.

So here is the code snippet. Hope someone else can use this.
Watch for the line wraps.

Suggestions and or improvements heartily accepted.

Private Sub SelectControls()

On Error Resume Next

Dim oCtrl As VBControl
Dim sFName As String

Dim sSelect As String
Dim asName() As String
Dim lX As Long
Dim asArgs() As String
Dim lCtrlIndex As Long
Dim bAccept As Boolean

Dim cmpCurrent As VBComponent

' User inputs control name.
' name may have wildcards opt*
' name may have specific Index

sSelect = InputBox("Control Names Separated By '|'", "Select
Controls By Name")
If LenB(sSelect) > 0 Then

Set cmpCurrent = VBInstance.SelectedVBComponent

asName() = Split(UCase$(sSelect), "|") ' make not case sensitive

sFName = VBInstance.SelectedVBComponent.Name ' just for fun
Debug.Print "sFName", sFName

Set cmpCurrent = VBInstance.SelectedVBComponent

For lX = 0 To UBound(asName)
Debug.Print "asName()", asName(lX)
asArgs = Split(asName(lX), "(")

asName(lX) = asArgs(0)
If UBound(asArgs) > 0 Then
lCtrlIndex = Val(asArgs(1)) ' just the numerics

Else
lCtrlIndex = -1

End If

For Each oCtrl In cmpCurrent.Designer.VBControls

Debug.Print "oCtrl.Properties!Name", oCtrl.Properties!Name,
Format$(oCtrl.Properties!TabIndex, "000"), ControlDescr(oCtrl)

If NameMatch(UCase$(oCtrl.Properties!Name), asName(lX))
Then
' got name match
' how about Index match if requested?
bAccept = False
If lCtrlIndex > -1 Then ' match index requested
If oCtrl.Properties!Index = lCtrlIndex Then
bAccept = True

End If

Else ' matching index NOT requested so Accept.
bAccept = True

End If

If bAccept Then
Debug.Print oCtrl.Container.Parent.Properties("Name")
oCtrl.InSelection = True ' select control
If Err Then
Debug.Print "Select Control " & Err.Description
Err = 0 ' clear error

End If

End If

End If

Next oCtrl

Next lX

End If

End Sub ' SelectControls

Private Function NameMatch(sName As String, sTest As String) As Boolean

' not case sensitive all been UCase$()
If IsAmb(sTest) Then
NameMatch = sName Like sTest

Else
NameMatch = (sName = sTest)

End If

End Function ' NameMatch

Private Function IsAmb(sName As String) As Boolean

' Ambiguous name == using * or ?
' just * ? for now

If InStr(1, sName, "*") > 0 Then
IsAmb = True

ElseIf InStr(1, sName, "?") > 0 Then
IsAmb = True

End If

End Function ' IsAmb

Private Function ControlDescr(oCtrl As VBIDE.VBControl) As String

' mostly for debugging and peeking
On Error Resume Next

Dim sName As String
Dim sCaption As String
Dim lIndex As Integer

sName = oCtrl.Properties!Name

sCaption = "<none>"
' ready for possible error next
sCaption = oCtrl.Properties!Caption
Err = 0

lIndex = oCtrl.Properties!Index
If lIndex > -1 Then
sName = sName & "(" & lIndex & ")"

End If

ControlDescr = sName
If LenB(sCaption) > 0 Then
ControlDescr = ControlDescr & -" & sCaption & " '"

End If

Err.Clear

End Function ' ControlDescr




0 new messages