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()
' Fonctionne pour les Variables déclarées Dim dans le Module
' Il y aura besoin de code supplémentaire pour des variables :
' Public, Private, Static, Array, Type ... End Type
Dim Titre As String
Dim Message As String
Dim Debut As Long
Dim ObjModule As Object
Dim TagLigne As Boolean ' on marque les lignes Dim inutilisée
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
' pour le moment sur le classeur courant
For Each ObjModule In ThisWorkbook.VBProject.VBComponents
NomModule = ObjModule.Name
' pour le moment test sur seulement un module
If NomModule = "Module6_PourVar" Then
With ThisWorkbook.VBProject.VBComponents(NomModule).CodeModule
'Déclarations du Module
'----------------------
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
' Chaque Procédure
'-----------------
'positionnement après la partie Déclarations du Module
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
' Analyse variables (pour le moment seulement Dim)
'-------------------
Quoi = "Dim "
' Préparation des tableaux de déclarations Dim
'---------------------------------------------
TabCodeDeclaration = Split(pCodeDeclaration, vbLf)
'la dernière ligne est vide
ReDim Preserve TabCodeDeclaration(0 To UBound(TabCodeDeclaration) - 1)
For i = LBound(TabCodeDeclaration) To UBound(TabCodeDeclaration)
' on enlève les espaces de gauche
TabCodeDeclaration(i) = LTrim(TabCodeDeclaration(i))
' on enlève le saut de ligne
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
' Ligne Dim
If ChaineDim = "" Then ChaineDim = TabCodeDeclaration(i) Else ChaineDim = ChaineDim & vbLf & TabCodeDeclaration(i)
End If
Next i
' TabDim contient toutes les déclarations Dim : "Dim xxx"
TabDim = Split(ChaineDim, vbLf)
' Tableau du contenu sans les lignes commentaires
'---------------------------------------------
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
' élimination des lignes commentaires
TabSansCom = Split(ChaineSansCom, vbLf)
' Contrôle du contenu à partir des tableaux de déclarations Dim
'--------------------------------------------------------------
For ITabDim = LBound(TabDim) To UBound(TabDim)
' ici on éclate les déclarations multiples sur la même e lignes en x lignes
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
' Variable Tableau
' -> pour détecter l'utilisation dans le code on testera "Var(" et "Var"
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
' on regarde si trouvé en dehors d'une zone commentaire
Pos2 = InStr(TabSansCom(ITabSansCom), "'")
If Pos2 <> 0 Then
' on a trouvé le caractère ' sur la ligne
If ChaineEntreApostrophes(TabSansCom(ITabSansCom), "'") Then
'le caractère ' est encadré par "" -> ce n'est donc pas commentaire
'on regarde si variable encadré par ""
Absent = ChaineEntreApostrophes(TabSansCom(ITabSansCom), TabDimEc(ITabDimEc))
If Not Absent Then Exit For
End If
Else
'pas dans zone commentaire
'on regarde si encadré par ""
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
' on marque la ligne Dim inutilisée
' recherche du n° d'item de TabDim à partir de TabDimEc
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
' on ajoute le tag
' on remplace le Tag précédent s'il existe
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
' pour le Debug.Print
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
'on regarde si encadré par ""
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
' le premier " est situé avant, on va regarder où est le suivant
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
' Var non trouvée hors zone commentaire
Fin = True
Case Pos2 = 0 And Pos <> 0
' pas de 2ème "
ChaineEntreApostrophes = False
Fin = True
Case Else
' 2ème " avant ou après la variable -> on avance
ChaineW = Mid(ChaineW, Pos2 + 1, Len(ChaineW))
End Select
Wend
Else
ChaineEntreApostrophes = False
End If
End Function
