get all the labels of all forms in array

[RB Smissaert]

Need to get all the labels of all forms in an array of custom objects.
This is in connection with control specific help.

Tried like this:

In Class module:
------------------------------

Option Explicit
Public WithEvents objLabel As MSForms.Label

Private Sub objLabel_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)

Dim lContextHelpID As Long

'The following is required because the MouseDown event
'fires twice when right-clicked !!
lClassRightClickCount = lClassRightClickCount + 1

' Do nothing on second firing of MouseDown event
If (lClassRightClickCount Mod 2 = 0) Then
Exit Sub
End If

If Button = 2 Then
On Error Resume Next
lContextHelpID = objLabel.Tag
On Error GoTo 0
If lContextHelpID > 0 Then
ShowHelp bWebHelp, lContextHelpID
End If
End If

End Sub


In Normal module:
--------------------------

Public Labels(241) As New LabelClass

Sub AddToLabelClass()

Dim oVBProj As VBProject
Dim oVBComp As VBComponent
Dim i As Long
Dim ctl As MSForms.Control

Set oVBProj = ThisWorkbook.VBProject

For Each oVBComp In oVBProj.VBComponents
If oVBComp.Type = 3 Then
For Each ctl In oVBComp.Designer.Controls
If TypeOf ctl Is MSForms.Label Then
Set Labels(i).objLabel = ctl
i = i + 1
End If
Next
End If
Next

End Sub


I get different error messages and it just doesn't work.
Maybe the trouble is with this:
For Each ctl In oVBComp.Designer.Controls
but haven't found another way yet.


Thanks for any assistance.


RBS

 

[Peter T]

Hi Bart,

I can't see this ever working, or maybe I misunderstand your objective.

Label events will only fire once its parent form is loaded, at which moment
(typically) you would set new instances of withevents class's during the
form's initialize event.

Only for demo (not for use in real life)

Sub LoadAndAddToLabelClass()
Dim vaForms
Dim obFm
Dim i As Long
Dim ctl As msforms.Control
'load the forms
vaForms = Array(UserForm1, UserForm2)
For Each obFm In vaForms
For Each ctl In obFm.Controls
If TypeOf ctl Is msforms.Label Then
Set Labels(i).objLabel = ctl
i = i + 1
End If
Next
Next
End Sub

If you now go on to show the forms the withevents should fire. However, if
any form gets unloaded the withevents will not fire next time you reload,
even though the class's properties & methods will still exist (assuming they
have not been erased or the public array erased).

Regards,
Peter T

 

[RB Smissaert]

Hi Peter,

Yes, I can see now that this can't work.
I will do it the way I did before that is add the controls to a collection
on initializing the form.
Having learned from you the Designer property I thought I could use it here
and simplify matters, but
I see now you can't.
Thanks for confirming this.

RBS

 

[RB Smissaert]

Just some refinements to this routine:


Sub ShowHelpContextIDsAndTags()

Dim oVBProj As VBProject
Dim oVBComp As VBComponent
Dim ctl As MSForms.Control
Dim strFormName As String
Dim strFormTag As String
Dim lFormHelpID As Long
Dim bAll As Boolean
Dim lFirst As Long
Dim i As Long
Dim n As Long
Dim m As Long

If MsgBox("Show all controls?", _
vbYesNo + vbDefaultButton2 + vbQuestion, _
"controls and help ID's and tags") = vbYes Then
bAll = True
End If

i = 1

Application.ScreenUpdating = False

Cells.Clear

Cells(1) = "Form Name"
Cells(2) = "Form Help ID"
Cells(3) = "Form Tag"
Cells(4) = "Control Name"
Cells(5) = "Control Type"
Cells(6) = "Control Help ID"
Cells(7) = "Control Tag"

Range(Cells(1), Cells(7)).Font.Bold = True
MediumBottomBorder Range(Cells(1), Cells(7))

Set oVBProj = ThisWorkbook.VBProject

On Error Resume Next

For Each oVBComp In oVBProj.VBComponents
If oVBComp.Type = 3 Then

strFormName = ""
lFormHelpID = 0
strFormTag = ""

strFormName = oVBComp.Properties("Name")
lFormHelpID = oVBComp.Properties("HelpContextID")
strFormTag = oVBComp.Properties("Tag")

For Each ctl In oVBComp.Designer.Controls
If TypeName(ctl) <> "Image" And _
TypeName(ctl) <> "ImageList" And _
TypeName(ctl) <> "CommonDialog" Then
If bAll Then
i = i + 1
Cells(i, 1) = strFormName
Cells(i, 2) = lFormHelpID
Cells(i, 3) = strFormTag
Cells(i, 4) = ctl.Name
Cells(i, 5) = TypeName(ctl)
Cells(i, 6) = ctl.HelpContextID
Cells(i, 7) = ctl.Tag
Else 'If bAll
If Len(ctl.Tag) > 0 Then
i = i + 1
Cells(i, 1) = strFormName
Cells(i, 2) = lFormHelpID
Cells(i, 3) = strFormTag
Cells(i, 4) = ctl.Name
Cells(i, 5) = TypeName(ctl)
Cells(i, 6) = ctl.HelpContextID
Cells(i, 7) = ctl.Tag
Else 'If Len(ctl.Tag) > 0
If ctl.HelpContextID > 0 Then
i = i + 1
Cells(i, 1) = strFormName
Cells(i, 2) = lFormHelpID
Cells(i, 3) = strFormTag
Cells(i, 4) = ctl.Name
Cells(i, 5) = TypeName(ctl)
Cells(i, 6) = ctl.HelpContextID
Cells(i, 7) = ctl.Tag
End If 'If ctl.HelpContextID > 0
End If 'If Len(ctl.Tag) > 0
End If 'If bAll Then
End If 'If TypeName(ctl) <> "Image" And etc.
Next 'For Each ctl In oVBComp.Designer.Controls
End If 'If oVBComp.Type = 3
Next 'For Each oVBComp In oVBProj.VBComponents

With Range(Cells(1), Cells(i, 7))
.Columns.AutoFit
.HorizontalAlignment = xlLeft
.Name = "HelpContextIDsAndTags"
'sort on Form name, then control type then control help ID
'---------------------------------------------------------
.Sort Key1:=Cells(1), Order1:=xlAscending, _
Key2:=Cells(5), Order2:=xlAscending, _
Key3:=Cells(6), Order3:=xlDescending, _
Header:=xlYes, _
MatchCase:=xlNo, _
Orientation:=xlTopToBottom
End With

lFirst = 2

For n = 2 To i + 1
If Cells(n, 1) <> Cells(n - 1, 1) Then
m = m + 1
If m > 1 Then
If m Mod 2 = 0 Then
Range(Cells(lFirst, 1), _
Cells(n - 1, 7)).Interior.ColorIndex = 19
Else 'If m Mod 2 = 0
Range(Cells(lFirst, 1), _
Cells(n - 1, 7)).Interior.ColorIndex = 20
End If 'If m Mod 2 = 0
End If 'If m > 1
lFirst = n
End If 'If Cells(n, 1) <> Cells(n - 1, 1)
Next 'For n = 2 To i + 1

Application.ScreenUpdating = True

End Sub


Sub MediumBottomBorder(rng As Range)

With rng
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With

End Sub


RBS