get all the labels of all forms in array
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
"Peter T" <peter_t@discussions wrote in message
...
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" wrote in message
...
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
|