Lister les modules

papou

15/09/2004 à 09:50

Bonjour
Va voir ici il y a des exemples :
http://perso.wanadoo.fr/frederic.sigonneau/VBE.htm
Cordialement
Pascal

"Fredo (67)" a écrit dans le message de
news:

Bonjour,
Je stocke toutes mes macros dans un fichier nommé Macros.xls
Y'a t'il moyen de créer une liste avec les noms de mes macros
indiquant le nom de la macro et le module dans lequel je peux la trouver.
Merci .

--
**********************
Fredo
Strasbourg

Alain CROS

15/09/2004 à 10:18

Bonjour

Pour lister toutes les macros d'un classeur ou d'une macro complémentaire ouvert dont le projet n'est pas protégé.

Sub ListeMacro()
Dim WK$
WK = ChoixProj
If WK <> "" Then Liste WK
End Sub

Function ChoixProj$()
Dim LeTexte$, LeProj$, I&, J&, K&, L&, MonTab() As String, LeTab
On Error Resume Next
K = Application.VBE.VBProjects.Count
On Error GoTo 0
#If VBA6 Then
Select Case K
Case 0
MsgBox "Impossible d'accéder aux projets VisualBasic": Exit Function
Case 1
MsgBox "Aucun projet disponible": Exit Function
End Select
#Else
If K = 1 Then MsgBox "Aucun projet disponible": Exit Function
L = K
K = Workbooks.Count
#End If
J = 1&
ReDim MonTab(0)
For I = 1& To K
Do
#If VBA6 Then
If Application.VBE.VBProjects(I) Is ThisWorkbook.VBProject Then Exit Do
LeTab = Split(Application.VBE.VBProjects(I).FileName, Application.PathSeparator)
LeProj = Workbooks(LeTab(UBound(LeTab))).Name
#Else
If Workbooks(I) Is ThisWorkbook Then Exit Do
LeProj = Workbooks(I).Name
#End If
LeTexte = LeTexte & vbNewLine & J & " : " & LeProj
ReDim Preserve MonTab(0& To UBound(MonTab) + 1&)
MonTab(UBound(MonTab)) = LeProj
J = J + 1&
Exit Do
Loop
Next I
#If VBA6 Then
#Else
If K < L Then
Dim Elt As AddIn
For Each Elt In Application.AddIns
With Elt
If .Installed = True Then
LeTexte = LeTexte & vbNewLine & J & " : " & .Name
ReDim Preserve MonTab(0& To UBound(MonTab) + 1&)
MonTab(UBound(MonTab)) = .Name
J = J + 1&
End If
End With
Next Elt
End If
#End If
ChoixProj = InputBox(LeTexte, "Choisir un Classeur")
On Error Resume Next
I = CLng(ChoixProj)
If I > J - 1& Then I = 0&
ChoixProj = MonTab(I)
End Function'AC

Sub Liste(WK$)
Dim DepLine&, FinLine&, I&, AncLine&, LaProc$
Dim MonTab() As String, ModCod As Object
If Workbooks(WK).VBProject.Protection = 1& Then _
MsgBox "Accès impossible car le projet est protégé": Exit Sub
ReDim MonTab(1& To 2&, 1& To 2&)
MonTab(1&, 1&) = Workbooks(WK).FullName
MonTab(1&, 2&) = "Module"
MonTab(2&, 2&) = "Procédure"
For Each ModCod In Workbooks(WK).VBProject.VBComponents
I = UBound(MonTab, 2&) + 1&
ReDim Preserve MonTab(1& To 2&, 1& To I)
With ModCod.CodeModule
MonTab(1&, I) = .Parent.Name
DepLine = .CountOfDeclarationLines
FinLine = .CountOfLines
Do
If FinLine > DepLine Then
On Error Resume Next
For I = 0& To 3&
LaProc = .ProcOfLine(DepLine + 1&, I)
AncLine = .ProcBodyLine(LaProc, I)
DepLine = DepLine + .ProcCountLines(LaProc, I)
If Not Err.Number Then Exit For
Next I
On Error GoTo 0
I = UBound(MonTab, 2&)
If MonTab(2&, I) <> "" Then
I = I + 1&
ReDim Preserve MonTab(1& To 2&, 1& To I)
End If
MonTab(2&, I) = LaProc
Else
Exit Do
End If
Loop
End With
Next
Set ModCod = Nothing
Application.ScreenUpdating = False
Workbooks.Add xlWBATWorksheet
With ActiveWorkbook.ActiveSheet
.Range("A1").Resize(UBound(MonTab, 2&), 2&) = Application.Transpose(MonTab)
With .UsedRange
.Columns(1&).Characters.Font.Bold = True
.Rows(2&).Characters.Font.Bold = True
With .Range("A1").Characters.Font
.Color = vbBlue
.Size = .Size + 2&
End With
.Offset(1).Columns.AutoFit
End With
End With
Application.ScreenUpdating = True
End Sub'AC

Alain CROS

"Fredo (67)" a écrit dans le message de news:

Bonjour,
Je stocke toutes mes macros dans un fichier nommé Macros.xls
Y'a t'il moyen de créer une liste avec les noms de mes macros
indiquant le nom de la macro et le module dans lequel je peux la trouver.
Merci .

--
**********************
Fredo
Strasbourg

Bonjour

Pour lister toutes les macros d'un classeur ou d'une macro complémentaire ouvert dont le projet n'est pas protégé.

Sub ListeMacro()
Dim WK$
WK = ChoixProj
If WK <> "" Then Liste WK
End Sub

Function ChoixProj$()
Dim LeTexte$, LeProj$, I&, J&, K&, L&, MonTab() As String, LeTab
On Error Resume Next
K = Application.VBE.VBProjects.Count
On Error GoTo 0
#If VBA6 Then
Select Case K
Case 0
MsgBox "Impossible d'accéder aux projets VisualBasic": Exit Function
Case 1
MsgBox "Aucun projet disponible": Exit Function
End Select
#Else
If K = 1 Then MsgBox "Aucun projet disponible": Exit Function
L = K
K = Workbooks.Count
#End If
J = 1&
ReDim MonTab(0)
For I = 1& To K
Do
#If VBA6 Then
If Application.VBE.VBProjects(I) Is ThisWorkbook.VBProject Then Exit Do
LeTab = Split(Application.VBE.VBProjects(I).FileName, Application.PathSeparator)
LeProj = Workbooks(LeTab(UBound(LeTab))).Name
#Else
If Workbooks(I) Is ThisWorkbook Then Exit Do
LeProj = Workbooks(I).Name
#End If
LeTexte = LeTexte & vbNewLine & J & " : " & LeProj
ReDim Preserve MonTab(0& To UBound(MonTab) + 1&)
MonTab(UBound(MonTab)) = LeProj
J = J + 1&
Exit Do
Loop
Next I
#If VBA6 Then
#Else
If K < L Then
Dim Elt As AddIn
For Each Elt In Application.AddIns
With Elt
If .Installed = True Then
LeTexte = LeTexte & vbNewLine & J & " : " & .Name
ReDim Preserve MonTab(0& To UBound(MonTab) + 1&)
MonTab(UBound(MonTab)) = .Name
J = J + 1&
End If
End With
Next Elt
End If
#End If
ChoixProj = InputBox(LeTexte, "Choisir un Classeur")
On Error Resume Next
I = CLng(ChoixProj)
If I > J - 1& Then I = 0&
ChoixProj = MonTab(I)
End Function'AC

Sub Liste(WK$)
Dim DepLine&, FinLine&, I&, AncLine&, LaProc$
Dim MonTab() As String, ModCod As Object
If Workbooks(WK).VBProject.Protection = 1& Then _
MsgBox "Accès impossible car le projet est protégé": Exit Sub
ReDim MonTab(1& To 2&, 1& To 2&)
MonTab(1&, 1&) = Workbooks(WK).FullName
MonTab(1&, 2&) = "Module"
MonTab(2&, 2&) = "Procédure"
For Each ModCod In Workbooks(WK).VBProject.VBComponents
I = UBound(MonTab, 2&) + 1&
ReDim Preserve MonTab(1& To 2&, 1& To I)
With ModCod.CodeModule
MonTab(1&, I) = .Parent.Name
DepLine = .CountOfDeclarationLines
FinLine = .CountOfLines
Do
If FinLine > DepLine Then
On Error Resume Next
For I = 0& To 3&
LaProc = .ProcOfLine(DepLine + 1&, I)
AncLine = .ProcBodyLine(LaProc, I)
DepLine = DepLine + .ProcCountLines(LaProc, I)
If Not Err.Number Then Exit For
Next I
On Error GoTo 0
I = UBound(MonTab, 2&)
If MonTab(2&, I) <> "" Then
I = I + 1&
ReDim Preserve MonTab(1& To 2&, 1& To I)
End If
MonTab(2&, I) = LaProc
Else
Exit Do
End If
Loop
End With
Next
Set ModCod = Nothing
Application.ScreenUpdating = False
Workbooks.Add xlWBATWorksheet
With ActiveWorkbook.ActiveSheet
.Range("A1").Resize(UBound(MonTab, 2&), 2&) = Application.Transpose(MonTab)
With .UsedRange
.Columns(1&).Characters.Font.Bold = True
.Rows(2&).Characters.Font.Bold = True
With .Range("A1").Characters.Font
.Color = vbBlue
.Size = .Size + 2&
End With
.Offset(1).Columns.AutoFit
End With
End With
Application.ScreenUpdating = True
End Sub'AC

Alain CROS

"Fredo (67)" <bidon@free.fr> a écrit dans le message de news: uXLLQfvmEHA.3756@TK2MSFTNGP11.phx.gbl...

Bonjour,
Je stocke toutes mes macros dans un fichier nommé Macros.xls
Y'a t'il moyen de créer une liste avec les noms de mes macros
indiquant le nom de la macro et le module dans lequel je peux la trouver.
Merci .

--
**********************
Fredo
Strasbourg

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour

Pour lister toutes les macros d'un classeur ou d'une macro complémentaire ouvert dont le projet n'est pas protégé.

Sub ListeMacro()
Dim WK$
WK = ChoixProj
If WK <> "" Then Liste WK
End Sub

Function ChoixProj$()
Dim LeTexte$, LeProj$, I&, J&, K&, L&, MonTab() As String, LeTab
On Error Resume Next
K = Application.VBE.VBProjects.Count
On Error GoTo 0
#If VBA6 Then
Select Case K
Case 0
MsgBox "Impossible d'accéder aux projets VisualBasic": Exit Function
Case 1
MsgBox "Aucun projet disponible": Exit Function
End Select
#Else
If K = 1 Then MsgBox "Aucun projet disponible": Exit Function
L = K
K = Workbooks.Count
#End If
J = 1&
ReDim MonTab(0)
For I = 1& To K
Do
#If VBA6 Then
If Application.VBE.VBProjects(I) Is ThisWorkbook.VBProject Then Exit Do
LeTab = Split(Application.VBE.VBProjects(I).FileName, Application.PathSeparator)
LeProj = Workbooks(LeTab(UBound(LeTab))).Name
#Else
If Workbooks(I) Is ThisWorkbook Then Exit Do
LeProj = Workbooks(I).Name
#End If
LeTexte = LeTexte & vbNewLine & J & " : " & LeProj
ReDim Preserve MonTab(0& To UBound(MonTab) + 1&)
MonTab(UBound(MonTab)) = LeProj
J = J + 1&
Exit Do
Loop
Next I
#If VBA6 Then
#Else
If K < L Then
Dim Elt As AddIn
For Each Elt In Application.AddIns
With Elt
If .Installed = True Then
LeTexte = LeTexte & vbNewLine & J & " : " & .Name
ReDim Preserve MonTab(0& To UBound(MonTab) + 1&)
MonTab(UBound(MonTab)) = .Name
J = J + 1&
End If
End With
Next Elt
End If
#End If
ChoixProj = InputBox(LeTexte, "Choisir un Classeur")
On Error Resume Next
I = CLng(ChoixProj)
If I > J - 1& Then I = 0&
ChoixProj = MonTab(I)
End Function'AC

Sub Liste(WK$)
Dim DepLine&, FinLine&, I&, AncLine&, LaProc$
Dim MonTab() As String, ModCod As Object
If Workbooks(WK).VBProject.Protection = 1& Then _
MsgBox "Accès impossible car le projet est protégé": Exit Sub
ReDim MonTab(1& To 2&, 1& To 2&)
MonTab(1&, 1&) = Workbooks(WK).FullName
MonTab(1&, 2&) = "Module"
MonTab(2&, 2&) = "Procédure"
For Each ModCod In Workbooks(WK).VBProject.VBComponents
I = UBound(MonTab, 2&) + 1&
ReDim Preserve MonTab(1& To 2&, 1& To I)
With ModCod.CodeModule
MonTab(1&, I) = .Parent.Name
DepLine = .CountOfDeclarationLines
FinLine = .CountOfLines
Do
If FinLine > DepLine Then
On Error Resume Next
For I = 0& To 3&
LaProc = .ProcOfLine(DepLine + 1&, I)
AncLine = .ProcBodyLine(LaProc, I)
DepLine = DepLine + .ProcCountLines(LaProc, I)
If Not Err.Number Then Exit For
Next I
On Error GoTo 0
I = UBound(MonTab, 2&)
If MonTab(2&, I) <> "" Then
I = I + 1&
ReDim Preserve MonTab(1& To 2&, 1& To I)
End If
MonTab(2&, I) = LaProc
Else
Exit Do
End If
Loop
End With
Next
Set ModCod = Nothing
Application.ScreenUpdating = False
Workbooks.Add xlWBATWorksheet
With ActiveWorkbook.ActiveSheet
.Range("A1").Resize(UBound(MonTab, 2&), 2&) = Application.Transpose(MonTab)
With .UsedRange
.Columns(1&).Characters.Font.Bold = True
.Rows(2&).Characters.Font.Bold = True
With .Range("A1").Characters.Font
.Color = vbBlue
.Size = .Size + 2&
End With
.Offset(1).Columns.AutoFit
End With
End With
Application.ScreenUpdating = True
End Sub'AC

Alain CROS

"Fredo (67)" a écrit dans le message de news:

Bonjour,
Je stocke toutes mes macros dans un fichier nommé Macros.xls
Y'a t'il moyen de créer une liste avec les noms de mes macros
indiquant le nom de la macro et le module dans lequel je peux la trouver.
Merci .

--
**********************
Fredo
Strasbourg

Fredo $67$

15/09/2004 à 10:23

merci

"papou" <cestpasbonpapou@çanonplus44.fr> a écrit dans le message de
news:

Bonjour
Va voir ici il y a des exemples :
http://perso.wanadoo.fr/frederic.sigonneau/VBE.htm
Cordialement
Pascal

"Fredo (67)" a écrit dans le message de
news:
Bonjour,
Je stocke toutes mes macros dans un fichier nommé Macros.xls
Y'a t'il moyen de créer une liste avec les noms de mes macros
indiquant le nom de la macro et le module dans lequel je peux la
trouver.

Merci .

--
**********************
Fredo
Strasbourg

Fredo $67$

15/09/2004 à 10:34

Merci Alain,

Le code que tu donne va parfaitement.
Mais merci tout de même à Papou..

"Alain CROS" a écrit dans le message de
news:

Bonjour

Pour lister toutes les macros d'un classeur ou d'une macro complémentaire
ouvert dont le projet n'est pas protégé.

Sub ListeMacro()
Dim WK$
WK = ChoixProj
If WK <> "" Then Liste WK
End Sub

Function ChoixProj$()
Dim LeTexte$, LeProj$, I&, J&, K&, L&, MonTab() As String, LeTab
On Error Resume Next
K = Application.VBE.VBProjects.Count
On Error GoTo 0
#If VBA6 Then
Select Case K
Case 0
MsgBox "Impossible d'accéder aux projets VisualBasic": Exit
Function

Case 1
MsgBox "Aucun projet disponible": Exit Function
End Select
#Else
If K = 1 Then MsgBox "Aucun projet disponible": Exit Function
L = K
K = Workbooks.Count
#End If
J = 1&
ReDim MonTab(0)
For I = 1& To K
Do
#If VBA6 Then
If Application.VBE.VBProjects(I) Is ThisWorkbook.VBProject
Then Exit Do

LeTab = Split(Application.VBE.VBProjects(I).FileName,
Application.PathSeparator)

LeProj = Workbooks(LeTab(UBound(LeTab))).Name
#Else
If Workbooks(I) Is ThisWorkbook Then Exit Do
LeProj = Workbooks(I).Name
#End If
LeTexte = LeTexte & vbNewLine & J & " : " & LeProj
ReDim Preserve MonTab(0& To UBound(MonTab) + 1&)
MonTab(UBound(MonTab)) = LeProj
J = J + 1&
Exit Do
Loop
Next I
#If VBA6 Then
#Else
If K < L Then
Dim Elt As AddIn
For Each Elt In Application.AddIns
With Elt
If .Installed = True Then
LeTexte = LeTexte & vbNewLine & J & " : " & .Name
ReDim Preserve MonTab(0& To UBound(MonTab) + 1&)
MonTab(UBound(MonTab)) = .Name
J = J + 1&
End If
End With
Next Elt
End If
#End If
ChoixProj = InputBox(LeTexte, "Choisir un Classeur")
On Error Resume Next
I = CLng(ChoixProj)
If I > J - 1& Then I = 0&
ChoixProj = MonTab(I)
End Function'AC

Sub Liste(WK$)
Dim DepLine&, FinLine&, I&, AncLine&, LaProc$
Dim MonTab() As String, ModCod As Object
If Workbooks(WK).VBProject.Protection = 1& Then _
MsgBox "Accès impossible car le projet est protégé": Exit Sub
ReDim MonTab(1& To 2&, 1& To 2&)
MonTab(1&, 1&) = Workbooks(WK).FullName
MonTab(1&, 2&) = "Module"
MonTab(2&, 2&) = "Procédure"
For Each ModCod In Workbooks(WK).VBProject.VBComponents
I = UBound(MonTab, 2&) + 1&
ReDim Preserve MonTab(1& To 2&, 1& To I)
With ModCod.CodeModule
MonTab(1&, I) = .Parent.Name
DepLine = .CountOfDeclarationLines
FinLine = .CountOfLines
Do
If FinLine > DepLine Then
On Error Resume Next
For I = 0& To 3&
LaProc = .ProcOfLine(DepLine + 1&, I)
AncLine = .ProcBodyLine(LaProc, I)
DepLine = DepLine + .ProcCountLines(LaProc, I)
If Not Err.Number Then Exit For
Next I
On Error GoTo 0
I = UBound(MonTab, 2&)
If MonTab(2&, I) <> "" Then
I = I + 1&
ReDim Preserve MonTab(1& To 2&, 1& To I)
End If
MonTab(2&, I) = LaProc
Else
Exit Do
End If
Loop
End With
Next
Set ModCod = Nothing
Application.ScreenUpdating = False
Workbooks.Add xlWBATWorksheet
With ActiveWorkbook.ActiveSheet
.Range("A1").Resize(UBound(MonTab, 2&), 2&) Application.Transpose(MonTab)
With .UsedRange
.Columns(1&).Characters.Font.Bold = True
.Rows(2&).Characters.Font.Bold = True
With .Range("A1").Characters.Font
.Color = vbBlue
.Size = .Size + 2&
End With
.Offset(1).Columns.AutoFit
End With
End With
Application.ScreenUpdating = True
End Sub'AC

Alain CROS

"Fredo (67)" a écrit dans le message de news:

Bonjour,
Je stocke toutes mes macros dans un fichier nommé Macros.xls
Y'a t'il moyen de créer une liste avec les noms de mes macros
indiquant le nom de la macro et le module dans lequel je peux la
trouver.

Merci .

--
**********************
Fredo
Strasbourg

Merci Alain,

Le code que tu donne va parfaitement.
Mais merci tout de même à Papou..

"Alain CROS" <Personne@ICI> a écrit dans le message de
news:OaSURyvmEHA.744@TK2MSFTNGP10.phx.gbl...

Bonjour

Pour lister toutes les macros d'un classeur ou d'une macro complémentaire
ouvert dont le projet n'est pas protégé.

Sub ListeMacro()
Dim WK$
WK = ChoixProj
If WK <> "" Then Liste WK
End Sub

Function ChoixProj$()
Dim LeTexte$, LeProj$, I&, J&, K&, L&, MonTab() As String, LeTab
On Error Resume Next
K = Application.VBE.VBProjects.Count
On Error GoTo 0
#If VBA6 Then
Select Case K
Case 0
MsgBox "Impossible d'accéder aux projets VisualBasic": Exit
Function

Case 1
MsgBox "Aucun projet disponible": Exit Function
End Select
#Else
If K = 1 Then MsgBox "Aucun projet disponible": Exit Function
L = K
K = Workbooks.Count
#End If
J = 1&
ReDim MonTab(0)
For I = 1& To K
Do
#If VBA6 Then
If Application.VBE.VBProjects(I) Is ThisWorkbook.VBProject
Then Exit Do

LeTab = Split(Application.VBE.VBProjects(I).FileName,
Application.PathSeparator)

LeProj = Workbooks(LeTab(UBound(LeTab))).Name
#Else
If Workbooks(I) Is ThisWorkbook Then Exit Do
LeProj = Workbooks(I).Name
#End If
LeTexte = LeTexte & vbNewLine & J & " : " & LeProj
ReDim Preserve MonTab(0& To UBound(MonTab) + 1&)
MonTab(UBound(MonTab)) = LeProj
J = J + 1&
Exit Do
Loop
Next I
#If VBA6 Then
#Else
If K < L Then
Dim Elt As AddIn
For Each Elt In Application.AddIns
With Elt
If .Installed = True Then
LeTexte = LeTexte & vbNewLine & J & " : " & .Name
ReDim Preserve MonTab(0& To UBound(MonTab) + 1&)
MonTab(UBound(MonTab)) = .Name
J = J + 1&
End If
End With
Next Elt
End If
#End If
ChoixProj = InputBox(LeTexte, "Choisir un Classeur")
On Error Resume Next
I = CLng(ChoixProj)
If I > J - 1& Then I = 0&
ChoixProj = MonTab(I)
End Function'AC

Sub Liste(WK$)
Dim DepLine&, FinLine&, I&, AncLine&, LaProc$
Dim MonTab() As String, ModCod As Object
If Workbooks(WK).VBProject.Protection = 1& Then _
MsgBox "Accès impossible car le projet est protégé": Exit Sub
ReDim MonTab(1& To 2&, 1& To 2&)
MonTab(1&, 1&) = Workbooks(WK).FullName
MonTab(1&, 2&) = "Module"
MonTab(2&, 2&) = "Procédure"
For Each ModCod In Workbooks(WK).VBProject.VBComponents
I = UBound(MonTab, 2&) + 1&
ReDim Preserve MonTab(1& To 2&, 1& To I)
With ModCod.CodeModule
MonTab(1&, I) = .Parent.Name
DepLine = .CountOfDeclarationLines
FinLine = .CountOfLines
Do
If FinLine > DepLine Then
On Error Resume Next
For I = 0& To 3&
LaProc = .ProcOfLine(DepLine + 1&, I)
AncLine = .ProcBodyLine(LaProc, I)
DepLine = DepLine + .ProcCountLines(LaProc, I)
If Not Err.Number Then Exit For
Next I
On Error GoTo 0
I = UBound(MonTab, 2&)
If MonTab(2&, I) <> "" Then
I = I + 1&
ReDim Preserve MonTab(1& To 2&, 1& To I)
End If
MonTab(2&, I) = LaProc
Else
Exit Do
End If
Loop
End With
Next
Set ModCod = Nothing
Application.ScreenUpdating = False
Workbooks.Add xlWBATWorksheet
With ActiveWorkbook.ActiveSheet
.Range("A1").Resize(UBound(MonTab, 2&), 2&) Application.Transpose(MonTab)
With .UsedRange
.Columns(1&).Characters.Font.Bold = True
.Rows(2&).Characters.Font.Bold = True
With .Range("A1").Characters.Font
.Color = vbBlue
.Size = .Size + 2&
End With
.Offset(1).Columns.AutoFit
End With
End With
Application.ScreenUpdating = True
End Sub'AC

Alain CROS

"Fredo (67)" <bidon@free.fr> a écrit dans le message de news:
uXLLQfvmEHA.3756@TK2MSFTNGP11.phx.gbl...

Bonjour,
Je stocke toutes mes macros dans un fichier nommé Macros.xls
Y'a t'il moyen de créer une liste avec les noms de mes macros
indiquant le nom de la macro et le module dans lequel je peux la
trouver.

Merci .

--
**********************
Fredo
Strasbourg

Vous avez filtré cet utilisateur ! Consultez son message

Merci Alain,

Le code que tu donne va parfaitement.
Mais merci tout de même à Papou..

"Alain CROS" a écrit dans le message de
news:

Bonjour

Pour lister toutes les macros d'un classeur ou d'une macro complémentaire
ouvert dont le projet n'est pas protégé.

Sub ListeMacro()
Dim WK$
WK = ChoixProj
If WK <> "" Then Liste WK
End Sub

Function ChoixProj$()
Dim LeTexte$, LeProj$, I&, J&, K&, L&, MonTab() As String, LeTab
On Error Resume Next
K = Application.VBE.VBProjects.Count
On Error GoTo 0
#If VBA6 Then
Select Case K
Case 0
MsgBox "Impossible d'accéder aux projets VisualBasic": Exit
Function

Case 1
MsgBox "Aucun projet disponible": Exit Function
End Select
#Else
If K = 1 Then MsgBox "Aucun projet disponible": Exit Function
L = K
K = Workbooks.Count
#End If
J = 1&
ReDim MonTab(0)
For I = 1& To K
Do
#If VBA6 Then
If Application.VBE.VBProjects(I) Is ThisWorkbook.VBProject
Then Exit Do

LeTab = Split(Application.VBE.VBProjects(I).FileName,
Application.PathSeparator)

LeProj = Workbooks(LeTab(UBound(LeTab))).Name
#Else
If Workbooks(I) Is ThisWorkbook Then Exit Do
LeProj = Workbooks(I).Name
#End If
LeTexte = LeTexte & vbNewLine & J & " : " & LeProj
ReDim Preserve MonTab(0& To UBound(MonTab) + 1&)
MonTab(UBound(MonTab)) = LeProj
J = J + 1&
Exit Do
Loop
Next I
#If VBA6 Then
#Else
If K < L Then
Dim Elt As AddIn
For Each Elt In Application.AddIns
With Elt
If .Installed = True Then
LeTexte = LeTexte & vbNewLine & J & " : " & .Name
ReDim Preserve MonTab(0& To UBound(MonTab) + 1&)
MonTab(UBound(MonTab)) = .Name
J = J + 1&
End If
End With
Next Elt
End If
#End If
ChoixProj = InputBox(LeTexte, "Choisir un Classeur")
On Error Resume Next
I = CLng(ChoixProj)
If I > J - 1& Then I = 0&
ChoixProj = MonTab(I)
End Function'AC

Sub Liste(WK$)
Dim DepLine&, FinLine&, I&, AncLine&, LaProc$
Dim MonTab() As String, ModCod As Object
If Workbooks(WK).VBProject.Protection = 1& Then _
MsgBox "Accès impossible car le projet est protégé": Exit Sub
ReDim MonTab(1& To 2&, 1& To 2&)
MonTab(1&, 1&) = Workbooks(WK).FullName
MonTab(1&, 2&) = "Module"
MonTab(2&, 2&) = "Procédure"
For Each ModCod In Workbooks(WK).VBProject.VBComponents
I = UBound(MonTab, 2&) + 1&
ReDim Preserve MonTab(1& To 2&, 1& To I)
With ModCod.CodeModule
MonTab(1&, I) = .Parent.Name
DepLine = .CountOfDeclarationLines
FinLine = .CountOfLines
Do
If FinLine > DepLine Then
On Error Resume Next
For I = 0& To 3&
LaProc = .ProcOfLine(DepLine + 1&, I)
AncLine = .ProcBodyLine(LaProc, I)
DepLine = DepLine + .ProcCountLines(LaProc, I)
If Not Err.Number Then Exit For
Next I
On Error GoTo 0
I = UBound(MonTab, 2&)
If MonTab(2&, I) <> "" Then
I = I + 1&
ReDim Preserve MonTab(1& To 2&, 1& To I)
End If
MonTab(2&, I) = LaProc
Else
Exit Do
End If
Loop
End With
Next
Set ModCod = Nothing
Application.ScreenUpdating = False
Workbooks.Add xlWBATWorksheet
With ActiveWorkbook.ActiveSheet
.Range("A1").Resize(UBound(MonTab, 2&), 2&) Application.Transpose(MonTab)
With .UsedRange
.Columns(1&).Characters.Font.Bold = True
.Rows(2&).Characters.Font.Bold = True
With .Range("A1").Characters.Font
.Color = vbBlue
.Size = .Size + 2&
End With
.Offset(1).Columns.AutoFit
End With
End With
Application.ScreenUpdating = True
End Sub'AC

Alain CROS

"Fredo (67)" a écrit dans le message de news:

Bonjour,
Je stocke toutes mes macros dans un fichier nommé Macros.xls
Y'a t'il moyen de créer une liste avec les noms de mes macros
indiquant le nom de la macro et le module dans lequel je peux la
trouver.

Merci .

--
**********************
Fredo
Strasbourg

Lister les modules

4 réponses

Veuillez sélectionner un problème