Attribute VB_Name = "Mod_Analyse_Code"
Option Explicit

Sub Main()
  Call ListeProcedures
  Call ListeAppels
End Sub

Public Sub ListeProcedures()
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
    Dim Component As Object
    Dim Name As String
    Dim Kind As Long
    Dim Index As Long
    Dim tmp$, n!
    Dim i!, fExist!
    Dim adr$
  
' Crée la feuille Liste procédures
  
  For i = 1 To ActiveWorkbook.Sheets.Count
    If Worksheets(i).Name = "liste procs" Then
      Worksheets("liste procs").Delete
      Exit For
    End If
  Next i
  If fExist = 0 Then
    Sheets.Add.Name = "liste procs"
    Range("A1:C1").Value = Array("nom Module", "nom Procédure", "Index")
    Range("A1:C1").Font.Bold = True
    Range("A1:C1").Borders.Value = 1
  End If
    
' Liste toutes les procédures du classeur
  For Each Component In Application.VBE.ActiveVBProject.VBComponents
  With Component.CodeModule
    Index = .CountOfDeclarationLines + 1
    Do While Index < .CountOfLines
      Name = .ProcOfLine(Index, Kind)
      tmp = Component.Name & "." & Name & "." & Index
      Sheets("liste procs").Range("A" & n + 2 & ":C" & n + 2).Value = Split(tmp, ".")
      n = n + 1
      Index = .ProcStartLine(Name, Kind) + .ProcCountLines(Name, Kind) + 1
    Loop
  End With
  Next Component
  Range("A:B").EntireColumn.AutoFit
  
  With Sheets("liste procs")
    adr = .[A1].CurrentRegion.Address
    .ListObjects.Add(xlSrcRange, .Range(adr), , xlYes).Name = "tb_procs"
    .ListObjects("tb_procs").TableStyle = "TableStyleLight14"
  End With
  
  
'  Worksheets("liste procs").Visible = False
  Application.DisplayAlerts = False
  Application.ScreenUpdating = True
End Sub

Sub ListeAppels()
  Dim nomModule$, NomMacro$
  Dim tbProcs()
  Dim i%, j%, k%
  Dim Debut!, Lignes!, n!, x!, fExist!
  Dim texte$, tmp$, adr$, source$, id$
  Dim dc As Object, cle
  
' Crée la feuille Liste appels
  For i = 1 To ActiveWorkbook.Sheets.Count
    If Worksheets(i).Name = "liste appels" Then
      Application.DisplayAlerts = False
      Worksheets("liste appels").Delete
      Application.DisplayAlerts = True
      Exit For
    End If
  Next i
  If fExist = 0 Then
    Sheets.Add.Name = "liste appels"
    Range("A1:G1").Value = Array("nom Procédure", "Module appelant", "Procédure appelante", _
      "Début", "Num ligne", "Localisation procédure", "Index")
    Range("A1:G1").Font.Bold = True
    Range("A1:G1").Borders.Value = 1
  End If
  
  tbProcs = Range("tb_procs").Value2
  Set dc = CreateObject("Scripting.dictionary")
  For i = 1 To UBound(tbProcs)
    dc(tbProcs(i, 2)) = ""
  Next i
  For Each cle In dc.keys
    For i = 1 To UBound(tbProcs)
      nomModule = tbProcs(i, 1)
      NomMacro = tbProcs(i, 2)
      If nomModule <> "Mod_Analyse_Code" Then
        With ThisWorkbook.VBProject.VBComponents(nomModule).CodeModule
            Debut = .ProcStartLine(NomMacro, 0)
            Lignes = .ProcCountLines(NomMacro, 0)
        End With
        For j = Debut + 2 To Lignes + Debut
          With ThisWorkbook.VBProject.VBComponents(nomModule).CodeModule
            texte = .Lines(j, 1)
            If InStr(1, texte, cle) > 0 Then
              texte = Trim(texte)
              For k = 1 To UBound(tbProcs)
                If tbProcs(k, 2) = cle Then
                  source = tbProcs(k, 1): id = tbProcs(k, 3)
                End If
              Next k
              tmp = cle & "|" & nomModule & "|" & NomMacro & "|" & Debut & "|" & j - Debut & "|" & source & "|" & id
              Sheets("liste appels").Range("A" & n + 2 & ":G" & n + 2).Value = Split(tmp, "|")
              n = n + 1
            End If
          End With
        Next j
      Else
      End If
    Next i
  Next cle
  
  Range("A:G").EntireColumn.AutoFit
  With Sheets("liste appels")
    adr = .[A1].CurrentRegion.Address
    .ListObjects.Add(xlSrcRange, .Range(adr), , xlYes).Name = "tb_appels"
    .ListObjects("tb_appels").TableStyle = "TableStyleLight12"
  End With
  
End Sub