Comment lister toutes les macro disponibles dans un projet ?

**payadz2** · 24/05/2021, 14h57

Bonjour;
je cherche désespérément un routine qui permet donc de lister toutes les MACRO + ROUTINES + FONCTIONS présentes dans un projet...
J' ai trouvé 2 pistes qui sont des échecs:
celle là ne génère pas d'erreur à l'exécution, mais ne renvoie rien...(bien sur testée avec une de mes routines présentes dans NORMAL.DOTM)
j'ai essayer de convertir Set MyModule = ActiveWorkbook.VBProject.vbComponents(MyModuleName).CodeModule en ActiveDocument.VBProject.VBComponents(MyModuleName).CodeModule puisque c'est pour WORD, mais la liste est toujours vide...
comment faire ?
PS Microsoft Visual Basic For Applications Extensibility est bien intégré en complément

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
'=================================================================================
'- CHECK IF A MODULE & SUBROUTINE EXISTS
'- VBA constant : vbext_pk_Proc = All procedures other than property procedures.
'- An error is generated if the Module or Sub() does not exist - so we trap them.
'---------------------------------------------------------------------------------
'- VB Editor : Tools/References - add reference TO ......
'-    .... "Microsoft Visual Basic For Applications Extensibility"
'----------------------------------------------------------------------------------
'- Brian Baulsom October 2007
'==================================================================================
Sub MacroExists()
    Dim MyModule As Object
    Dim MyModuleName As String
    Dim MySub As String
    Dim MyLine As Long
    '---------------------------------------------------------------------------
    '- test data
    MyModuleName = "TestModule"
    MySub = "Number2"
    '----------------------------------------------------------------------------
    On Error Resume Next
    '- MODULE
    Set MyModule = ActiveDocument.VBProject.VBComponents(MyModuleName).CodeModule
    If err.Number <> 0 Then
        MsgBox ("Module : " & MyModuleName & vbCr & "does not exist.")
        Exit Sub
    End If
    '-----------------------------------------------------------------------------
    '- SUBROUTINE
    '- find first line of subroutine (or error)
    MyLine = MyModule.ProcStartLine(MySub, vbext_pk_Proc)
    If err.Number <> 0 Then
        MsgBox ("Module exists      : " & MyModuleName & vbCr _
               & "Sub " & MySub & "( )  : does not exist.")
    Else
        MsgBox ("Module : " & MyModuleName & vbCr _
            & "Subroutine   : " & MySub & vbCr _
            & "Line Number : " & MyLine)
    End If
End Sub
'-----------------------------------------------------------------------------------

Invité · 24/05/2021, 17h40

Envoyé par payadz2

Bonjour,

A mettre dans un module standard :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
 
Sub MacroExists()
 
Dim MyModule As CodeModule
Dim MyModuleName As String, MySub As String
Dim I As Integer, IndexMatrice As Integer, MyLine As Long
Dim PresenceModule As Boolean, PresenceProcedure As Boolean
Dim Matrice() As Variant
 
 
    '---------------------------------------------------------------------------
    '- test data
    MyModuleName = "TestModule"
    MySub = "Number2"
    '----------------------------------------------------------------------------
    On Error Resume Next
    '- MODULE
    With ActiveDocument.VBProject
         PresenceModule = False
 
         If .VBComponents.Count > 0 Then
            For I = 1 To .VBComponents.Count
                If .VBComponents(I).Name = MyModuleName Then
                   PresenceModule = True
                   Set MyModule = .VBComponents(MyModuleName).CodeModule
                   Exit For
                End If
            Next I
        End If
        If PresenceModule = False Then
            MsgBox "Module : " & MyModuleName & vbCr & "does not exist.", vbInformation
            Exit Sub
        End If
    End With
    '-----------------------------------------------------------------------------
    '- SUBROUTINE
    '- find first line of subroutine (or error)
    IndexMatrice = 0
    With MyModule
         For I = 1 To .CountOfLines
             If Mid(.Lines(I, 1), 1, 3) = "Sub" Then
                ReDim Preserve Matrice(2, IndexMatrice)
                Matrice(0, IndexMatrice) = Mid(Split(.Lines(I, 1), "(")(0), 5)
                Matrice(1, IndexMatrice) = I
                Matrice(2, IndexMatrice) = "Sub"
                IndexMatrice = IndexMatrice + 1
             End If
 
             If Mid(.Lines(I, 1), 1, 8) = "Function" Then
                ReDim Preserve Matrice(2, IndexMatrice)
                Matrice(0, IndexMatrice) = Mid(Split(.Lines(I, 1), "(")(0), 10)
                Matrice(1, IndexMatrice) = I
                Matrice(2, IndexMatrice) = "Fonction"
                IndexMatrice = IndexMatrice + 1
             End If
 
         Next I
    End With
 
    If IndexMatrice = 0 Then
        MsgBox "Module : " & MyModuleName & " vide.", vbCritical
        Exit Sub
    End If
 
    PresenceProcedure = False
    For IndexMatrice = LBound(Matrice, 2) To UBound(Matrice, 2)
       Debug.Print Matrice(0, IndexMatrice)
        If Matrice(0, IndexMatrice) = MySub Then
           MsgBox "Module : " & MyModuleName & " : " & Matrice(2, IndexMatrice) & " : " & MySub & ", Line Number : " & Matrice(1, IndexMatrice), vbInformation
           PresenceProcedure = True
        End If
    Next IndexMatrice
 
    If PresenceProcedure = False Then
       MsgBox "Module exists      : " & MyModuleName & " : Sub " & MySub & " does not exist.", vbCritical
    End If
 
    Set MyModule = Nothing
 
End Sub

**payadz2** · 24/05/2021, 17h49

Merci beaucoup, je vais essayer...(je vais essayer aussi de comprendre)
Pendant ce temps là, j'ai cherché aussi, et j'ai fini par écrire (à partir de référence citée et après modifications) une procédure qui fonctionne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Function Exist_VBE(s_2_Find As String) As Boolean
'Macro de LL https://www.generation-nt.com/reponses/exportation-code-vba-entraide-4295857.html
'2021-05-24 ok MAIS explore le document ACTIF pas NORMAL.dotm >>> NormalTemplate.VBProject.VBComponents
'=================================================================
'Cette macro liste dans Word le détail de tous les modules du VBE >> suprimé >>> debug uniquement (à commenter éventuellement)
'on ne recherche plus que le nom des SUB ou des FUNCTION
'Attention ! :
'Ajouter les références :
' . "Microsoft Word X.0 Object Library"
' . "Microsoft Visual Basic For Applications Extensibility 5.3"
'=================================================================
Dim oMod As VBComponent, W As word.Application
Dim i, j As Integer
Dim s_Sub As String
 
 
s_2_Find = Trim(s_2_Find)
 
On Error Resume Next
Set W = GetObject(Class:="Word.Application")
On Error GoTo 0
If W Is Nothing Then
    Set W = New word.Application
    W.visible = True
End If
'''W.ScreenUpdating = False
On Error GoTo Fin
 
For Each oMod In NormalTemplate.VBProject.VBComponents
    With oMod.CodeModule
'    Debug.Print "oMod.CodeModule: " & oMod.CodeModule   'donne le nom du module ok
        If .CountOfLines And .name <> "CopieCodeVersWord" Then
        For i = 1 To .CountOfLines
        If Left(.Lines(i, 1), 3) = "Sub" Then
        '    Debug.Print .Lines(i, 1)
            s_Sub = .Lines(i, 1)
            s_Sub = Right(s_Sub, Len(s_Sub) - 4)
            s_Sub = Left(s_Sub, InStr(s_Sub, "(") - 1)
            Debug.Print s_Sub
            If s_Sub = s_2_Find Then
                Exist_VBE = True
                Exit For
            End If
        End If
        If Left(.Lines(i, 1), 10) = "Public Sub" Then
        '    Debug.Print .Lines(i, 1)
            s_Sub = .Lines(i, 1)
            s_Sub = Right(s_Sub, Len(s_Sub) - 11)
            s_Sub = Left(s_Sub, InStr(s_Sub, "(") - 1)
            Debug.Print s_Sub
                        If s_Sub = s_2_Find Then
                Exist_VBE = True
                Exit For
            End If
        End If
        If Left(.Lines(i, 1), 8) = "Function" Then
        '    Debug.Print .Lines(i, 1)
            s_Sub = .Lines(i, 1)
            s_Sub = Right(s_Sub, Len(s_Sub) - 9)
            s_Sub = Left(s_Sub, InStr(s_Sub, "(") - 1)
            Debug.Print s_Sub
                        If s_Sub = s_2_Find Then
                Exist_VBE = True
                Exit For
            End If
        End If
 
        Next i
        End If
    End With
Next oMod
Fin:
'Exist_VBE = False
End Function

pour l'appeler:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub Exist_VBE_Test()
Dim s As String
s = "AutoExec"
MsgBox "La procedure : " & s & " existe-t-elle ? " & Exist_VBE(s)
s = "AutoExeQUE"
MsgBox "La procedure : " & s & " existe-t-elle ? " & Exist_VBE(s)
End Sub

**payadz2** · 24/05/2021, 19h05

Je pense que l'on peut mettre RESOLU, puisque l'on a maintenant 2 possibilités de répondre à la question.
Encore merci.
cordialement

Comment lister toutes les macro disponibles dans un projet ? [Toutes versions]

Word

Discussions similaires

Partager

Partager