Bonjour,
Je me suis permis de modifier votre macro dans le module _callback :
''''''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)
Car si aucun classeur ouvert? la macro plantait :
ci dessous la nouvelle version que j'ai faite qui fonctionne très bien. Ca teste si un classeur est ouvert ou non :
' procédure {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 wb As Workbook
Dim VbComp As Object, VbComps As Object
Dim code As String, t As Variant, i As Long
Dim ok As Boolean, lasub As String, a As Long, cl As Long
' Test si classeur actif est un .xlsm avec accès autorisé
Set wb = ActiveWorkbook
If wb Is Nothing Then Exit Sub
If LCase(Right(wb.Name, 5)) <> ".xlsm" Then
MsgBox "Ce menu ne fonctionne que sur un classeur .xlsm", vbExclamation
Exit Sub
End If
On Error GoTo ErreurVBA
Set VbComps = wb.VBProject.VBComponents
On Error GoTo 0
content = "<menu xmlns=""
http://schemas.microsoft.com/office/2006/01/customui"">" & vbCrLf
For Each VbComp In VbComps
cl = VbComp.CodeModule.CountOfLines
If cl > 0 Then
code = VbComp.CodeModule.Lines(1, cl)
If Trim(code) <> "" Then
a = a + 1
content = content & "<menu id=""" & VbComp.Name & a & """ label=""Module : " & 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=""" & VbComp.Name & 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
content = content & "</menu>"
Debug.Print content
Exit Sub
ErreurVBA:
MsgBox "Impossible d'accéder au projet VBA." & vbCrLf & _
"Assurez-vous que l'accès au modèle d'objet VBA est activé dans les paramètres de sécurité.", vbCritical
End Sub