Option Explicit
Dim NomModule As String
Dim NomProc As String
Dim TypeProcedure As vbext_ProcKind
Dim LigneStartProc As Long
Dim LigneBodyProc As Long
Dim NbLignesProc As Long
Dim CodeContenu As String
Dim CodeDeclaration As String
Dim ListeVar As String
Dim NbInutile As Integer
Const TAG = " ' VARIABLE INUTILE"
Dim CommentaireTag As String
Sub AnalyseCodeVarInu()
Dim Titre As String
Dim Message As String
Dim Debut As Long
Dim ObjModule As Object
Dim TagLigne As Boolean
Titre = "Analyse des Variables inutilisées"
Message = "Souhaitez-vous ajouter le commentaire <" & TAG & "> sur la ligne de déclaration des variables inutilisées ?"
If MsgBox(Message, vbYesNo, Titre) = vbYes Then
TagLigne = True
CommentaireTag = TAG & " (" & Now & ")"
Else
TagLigne = False
End If
NbInutile = 0
For Each ObjModule In ThisWorkbook.VBProject.VBComponents
NomModule = ObjModule.Name
If NomModule = "Module6_PourVar" Then
With ThisWorkbook.VBProject.VBComponents(NomModule).CodeModule
ListeVar = ""
NomProc = ""
LigneStartProc = 1
LigneBodyProc = 1
NbLignesProc = .CountOfLines - .CountOfDeclarationLines
NbLignesProc = .CountOfDeclarationLines
If NbLignesProc > 0 Then
CodeDeclaration = .Lines(1, .CountOfDeclarationLines) & vbLf
CodeContenu = .Lines(1, .CountOfLines)
AnalyseCodeVarInuProcedure CodeDeclaration, CodeContenu, TagLigne
End If
Debug.Print "========================================================="
Debug.Print " Analyse du Module " & NomModule
Debug.Print "========================================================="
Debug.Print ListeVar
Debug.Print
ListeVar = ""
Debut = .CountOfDeclarationLines + 1
Do Until Debut >= .CountOfLines
NomProc = .ProcOfLine(Debut, TypeProcedure)
LigneStartProc = .ProcStartLine(NomProc, TypeProcedure)
LigneBodyProc = .ProcBodyLine(NomProc, TypeProcedure)
NbLignesProc = .ProcCountLines(NomProc, TypeProcedure)
CodeContenu = .Lines(LigneBodyProc, NbLignesProc)
AnalyseCodeVarInuProcedure CodeContenu, CodeContenu, TagLigne
If ListeVar <> "" Then
Debug.Print "--- Procédure " & NomProc & " ---"
Debug.Print ListeVar
Debug.Print
End If
ListeVar = ""
Debut = Debut + NbLignesProc + 1
Loop
End With
Message = "Analyse du Code du Module " & NomModule & " terminée." & vbLf _
& NbInutile & " variables inutilisées." & vbLf _
& "Voir la fenêtre Exécution de l'éditeur VBE"
MsgBox Message, vbInformation, Titre
End If
Next ObjModule
End Sub
Sub AnalyseCodeVarInuProcedure(pCodeDeclaration As String, pCodeContenu As String, pTagLigne As Boolean)
Dim TabCodeDeclaration() As String
Dim TabCodeContenu() As String
Dim ChaineDim As String
Dim TabDim() As String, ITabDim As Integer, ITabDim2 As Integer, ITabDim3 As Integer
Dim TabDimEc() As String, ITabDimEc As Integer
Dim ChaineSansCom As String
Dim TabSansCom() As String, ITabSansCom As Integer
Dim i As Integer, j As Integer
Dim LigneCourante As String
Dim Quoi As String
Dim ChaineW As String
Dim Pos As Long, Pos2 As Long
Dim Absent As Boolean
Dim Fin As Boolean
Quoi = "Dim "
TabCodeDeclaration = Split(pCodeDeclaration, vbLf)
ReDim Preserve TabCodeDeclaration(0 To UBound(TabCodeDeclaration) - 1)
For i = LBound(TabCodeDeclaration) To UBound(TabCodeDeclaration)
TabCodeDeclaration(i) = LTrim(TabCodeDeclaration(i))
If Len(TabCodeDeclaration(i)) <> 0 And i < UBound(TabCodeDeclaration) - LBound(TabCodeDeclaration) Then
TabCodeDeclaration(i) = Left(TabCodeDeclaration(i), Len(TabCodeDeclaration(i)) - 1)
End If
If Left(LTrim(TabCodeDeclaration(i)), Len(Quoi)) = Quoi Then
If ChaineDim = "" Then ChaineDim = TabCodeDeclaration(i) Else ChaineDim = ChaineDim & vbLf & TabCodeDeclaration(i)
End If
Next i
TabDim = Split(ChaineDim, vbLf)
ChaineSansCom = ""
TabCodeContenu = Split(pCodeContenu, vbLf)
For i = LBound(TabCodeContenu) To UBound(TabCodeContenu)
If Len(TabCodeContenu(i)) <> 0 And i <> UBound(TabCodeContenu) Then TabCodeContenu(i) = Left(TabCodeContenu(i), Len(TabCodeContenu(i)) - 1)
If Left(LTrim(TabCodeContenu(i)), Len(Quoi)) <> Quoi Then
If Left(LTrim(TabCodeContenu(i)), 1) <> "'" Then
If ChaineSansCom = "" Then ChaineSansCom = TabCodeContenu(i) Else ChaineSansCom = ChaineSansCom & vbLf & TabCodeContenu(i)
End If
End If
Next i
TabSansCom = Split(ChaineSansCom, vbLf)
For ITabDim = LBound(TabDim) To UBound(TabDim)
TabDimEc = Filter(Split(Replace(Replace(TabDim(ITabDim), "Dim ", "Dim µ"), ", ", " µ")), "µ")
For i = LBound(TabDimEc) To UBound(TabDimEc)
TabDimEc(i) = Replace(TabDimEc(i), "µ", "")
If InStr(TabDimEc(i), "(") <> 0 Then
TabDimEc(i) = Left(TabDimEc(i), InStr(TabDimEc(i), "(") - 1)
End If
Next i
For ITabDimEc = LBound(TabDimEc) To UBound(TabDimEc)
Absent = True
For ITabSansCom = LBound(TabSansCom) To UBound(TabSansCom)
Pos = InStr(TabSansCom(ITabSansCom), TabDimEc(ITabDimEc))
If InStr(TabSansCom(ITabSansCom), TabDimEc(ITabDimEc)) <> 0 Then
Pos2 = InStr(TabSansCom(ITabSansCom), "'")
If Pos2 <> 0 Then
If ChaineEntreApostrophes(TabSansCom(ITabSansCom), "'") Then
Absent = ChaineEntreApostrophes(TabSansCom(ITabSansCom), TabDimEc(ITabDimEc))
If Not Absent Then Exit For
End If
Else
Absent = ChaineEntreApostrophes(TabSansCom(ITabSansCom), TabDimEc(ITabDimEc))
If Not Absent Then Exit For
End If
End If
Next ITabSansCom
If Absent Then
NbInutile = NbInutile + 1
If pTagLigne Then
For ITabDim2 = LBound(TabDim) To UBound(TabDim)
If InStr(TabDim(ITabDim2), TabDimEc(ITabDimEc)) <> 0 Then
ITabDim3 = ITabDim2
Exit For
End If
Next ITabDim2
For i = LigneBodyProc To LigneBodyProc + NbLignesProc - 1
LigneCourante = ThisWorkbook.VBProject.VBComponents(NomModule).CodeModule.Lines(i, 1)
If TabDim(ITabDim3) = LTrim(LigneCourante) Then
Pos = InStr(LigneCourante, TAG)
If Pos <> 0 Then
LigneCourante = Left(LigneCourante, Pos - 1)
End If
LigneCourante = LigneCourante & CommentaireTag & " ---> " & TabDimEc(ITabDimEc)
ThisWorkbook.VBProject.VBComponents(NomModule).CodeModule.ReplaceLine Line:=i, String:=LigneCourante
Exit For
End If
Next i
End If
If ListeVar = "" Then ListeVar = ListeVar & TabDimEc(ITabDimEc) Else ListeVar = ListeVar & vbLf & TabDimEc(ITabDimEc)
End If
Next ITabDimEc
Next ITabDim
End Sub
Function ChaineEntreApostrophes(pChaine As String, pSousChaine As String) As Boolean
Dim ChaineW As String
Dim Pos As Long, Pos2 As Long
Dim Absent As Boolean
Dim Fin As Boolean
ChaineEntreApostrophes = True
Pos = InStr(pChaine, pSousChaine)
Pos2 = InStr(pChaine, """")
If Pos2 < Pos Then
ChaineW = Mid(pChaine, Pos2 + 1, Len(pChaine))
Fin = False
While Not Fin
Pos = InStr(ChaineW, pSousChaine)
Pos2 = InStr(ChaineW, """")
Select Case True
Case Pos = 0
Fin = True
Case Pos2 = 0 And Pos <> 0
ChaineEntreApostrophes = False
Fin = True
Case Else
ChaineW = Mid(ChaineW, Pos2 + 1, Len(ChaineW))
End Select
Wend
Else
ChaineEntreApostrophes = False
End If
End Function
