'procedure {getContent} de remplissage du DynamicMenu[ID:''dynamicMenu_2'' Label:''Liste Macro'']'dans le parent [group_2'' Label:''Export Sub et Fonctions'']
Public Sub dynamicMenu_2_getContent(ctl As IRibbonControl, ByRef content)
Dim VbComp, VbComps, code, t, i&, ok As Boolean, lasub, a, cl&, idx, pl&, TT$
Set VbComps = ActiveWorkbook.VBProject.VBComponents
content = "<menu xmlns=""http://schemas.microsoft.com/office/2006/01/customui"" >" & vbCrLf 'ouverture de la balise menu
For Each VbComp In VbComps
cl = VbComp.CodeModule.CountOfLines
Select Case VbComp.Type
Case vbext_ct_StdModule ' = 1
TT = "Module"
Case vbext_ct_ClassModule ' = 2
TT = "Class"
Case vbext_ct_MSForm ' = 3
TT = "UserForm"
Case vbext_ct_Document ' = 100
If VbComp.Name = "ThisWorkbook" Then
TT = "ThisWorkbook"
Else
TT = "Feuille"
End If
Case Else
TT = "Inconnu"
End Select
If cl > 0 Then
code = VbComp.CodeModule.Lines(1, VbComp.CodeModule.CountOfLines)
If Trim(code) <> "" Then
pl = pl + 1: idx = "M" & Format(Date + pl, "yyyymmdd")
a = a + 1
content = content & "<menu id=""" & VbComp.Name & idx & a & Chr(34) & " label=""" & TT & " : " & VbComp.Name & """ >" & vbCrLf
t = Split(code & vbCrLf, vbCrLf)
For i = 1 To UBound(t)
ok = False
Select Case True
Case Left(Trim(t(i)), 4) = "Sub "
ok = True
Case Left(Trim(t(i)), 11) = "Private Sub "
ok = True
Case Left(Trim(t(i)), 11) = "Public Sub "
ok = True
Case Left(Trim(t(i)), 9) = "Function "
ok = True
Case Left(Trim(t(i)), 17) = "Private Function "
ok = True
Case Left(Trim(t(i)), 16) = "Public Function "
ok = True
End Select
If ok Then
lasub = Trim(Split(t(i), "(")(0))
content = content & "<button id=""B" & VbComp.Name & CLng(Date + i) & """ label=""" & lasub & """ imageMso=""MailMergeGreetingLineInsert"" onAction=""ExporteLaSub"""
content = content & " tag=""" & VbComp.Name & "|" & lasub & """ />" & vbCrLf
End If
Next
content = content & "</menu>" & vbCrLf
End If
End If
Next
DoEvents
content = content & "</menu>"
'Debug.Print content
End Sub