La colorisation du texte des cellules suivant leur contenu peut améliorer la lisibilité des tableurs comportant un grand nombre de cellules.
La macro proposée réalise la colorisation de toutes les cellules d’un tableur suivant la charte suivante :
- le texte des cellules contenant des calculs EXCEL est colorisé en vert
- le texte des cellules contenant une référence à une autre cellule de la même feuille est colorisé en bleu marine
- le texte des cellules contenant une référence à une autre cellule dans une autre feuille est colorisé en violet
- Dans tous ces cas, le corps du texte est mis en gras
- Le texte de la cellule est colorisé en rouge dans le cas où son contenu est #REF!
Les couleurs peuvent être modifiées pour correspondre à une autre charte de couleurs.
L’utilisateur indique le tableur à coloriser, la macro s’occupe du reste…
Sub ColorisationDesCellules()
'------------------------------------------------------------------------------------------------
'Procédure de colorisation des cellules d'un classeur contenant des formules
'-l'utilisateur doit choisir le classeur à traiter
'-Le traitement met évidence par la couleur de certaines cellules du classeur suivant la charte suivante :
'- le texte des cellules contenant des calculs EXCEL est colorisé en vert
'- le texte des cellules contenant une référence à une autre cellule de la même feuille est colorisé en bleu marine
'- le texte des cellules contenant une référence à une autre cellule dans une autre feuille est colorisé en violet
'- Dans tous ces cas, le corps du texte est mis en gras
'- Le texte de la cellule est colorisé en rouge dans le cas où son contenu est #REF!
'Le classeur reste ouvert après le traitement
'Vous pouvez adapter les couleurs à votre propre charte en changeant les valeurs des constantes déclarées en tête:
' cCouleurCalcul | cCouleurReferenceInterne | cCouleurReferenceExterne | cCouleurErreur.
'Auteur : Excellons.org
'Date : juin 2019
'------------------------------------------------------------------------------------------------
Const cCouleurCalcul = 3506772 'Vert : A adapter
Const cCouleurReferenceInterne = 9851952 'Bleu : A adapter
Const cCouleurReferenceExterne = 10498160 'Violet: A adapter
Const cCouleurErreur = vbRed 'Rouge : A adapter
Const cFilter = "Classeur EXCEL(*.xls*), *.xls*"
Dim oWB As Workbook
Dim oSheet As Worksheet
Dim oRangeToScan As Range
Dim oCell As Range
Dim sWBName As Variant
Dim sExtension As String
Dim sDecoupe() As String
Dim lErr As Long
Dim i As Integer
'On demande à l'utilisateur d'indiquer le nom du classeur à traiter
sWBName = Application.GetOpenFilename(cFilter, 1, "Choisissez le classeur à traiter", , False)
'On s'assure que l'utilisateur n'a pas quitté la boite de dialogue sans indiquer de fichier. Sinon on met fin à l'opération.
If sWBName = False Then
MsgBox "Aucun classeur indiqué !" & vbCrLf & vbCrLf & "Opération sans objet.", vbCritical, "FIN D'OPERATION"
Exit Sub
End If
'On s'assure que l'utilisateur a indiqué un classeur EXCEL
sDecoupe() = Split(sWBName, ".") 'On découpe le nom en 2 pour récupérer son extension
'On s'assure que le fichier choisi possède une extension de classeur EXCEL. Sinon on met fin à l'opération.
If Left(sDecoupe(1), 3) <> "xls" Then
MsgBox "Le fichier indiqué ne semble pas être un classeur EXCEL !" & vbCrLf & vbCrLf & "Opération sans objet.", vbCritical, "FIN D'OPERATION"
Exit Sub
End If
'On active la séquence de gestion d'erreurs
On Error GoTo Gestion_Err
'On affecte l'objet local classeur
Set oWB = Application.Workbooks.Open(sWBName)
'On inspecte toutes les feuilles du classeur
For Each oSheet In oWB.Worksheets
'On s'assure que la feuille n'est pas protégée
If Not oSheet.ProtectContents Then
'On affecte la plage de cellules à inspecter -> seulement les cellules contenant une formule
On Error Resume Next
Set oRangeToScan = oSheet.Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo Gestion_Err 'On rétablit la gestion des erreurs
'On s'assure que la feuille possède des cellules avec formule
If Not oRangeToScan Is Nothing Then
'On inspecte les toutes cellules de la plage
For Each oCell In oRangeToScan.Cells
'On s'assure que la cellule ne contient pas d'erreur
If Not IsError(oCell.Value) Then
'On met en gras le corps du texte de la cellule
oCell.Font.Bold = True
On Error GoTo 0 'On doit annuler la séquence de débranchement d'erreur
On Error Resume Next 'On poursuit le traitement même en cas d'erreur
Application.GoTo oCell.FormulaR1C1 'On tente d'atteindre la cellule référencée dans la formule
'On s'assure du numéro de l'erreur générée par l'instruction précédente
Select Case Err.Number
Case Is = 0 'La référence a été atteinte -> la cellule contient une référence à une cellule
'On teste pour savoir si la cellule contient une référence à une feuille
If InStr(1, oCell.Formula, "!") > 0 Then
'Si oui, on colorise le texte avec la couleur affectée aux références externes
oCell.Font.Color = cCouleurReferenceExterne
Else
'Sinon on colorise le texte de la cellule avec la couleur affectée aux références internes
oCell.Font.Color = cCouleurReferenceInterne
End If
On Error GoTo Gestion_Err 'On rétablit la gestion des erreurs
Case Is = 1004 'La référence est incorrecte -> la cellule contient un calcul
'On colorise le texte de la cellule avec la couleur affectée aux calculs
oCell.Font.Color = cCouleurCalcul
Err.Clear
On Error GoTo Gestion_Err 'On rétablit la gestion des erreurs
Case Else
'Si une autre erreur est survenue, on se débranche vers la séquence de gestion des erreurs
lErr = Err.Number
On Error GoTo Gestion_Err 'On rétablit la gestion des erreurs
Err.Raise lErr 'On déclenche l'erreur
End Select
Else
oCell.Font.Color = cCouleurErreur
End If
Next
End If
'on fait le ménage
Set oRangeToScan = Nothing
End If
Next
'Séquence de fin de traitement
MsgBox "Les cellules du classeur :" & vbCrLf & "'" & sWBName & "'" & vbCrLf & "contenant des formules ont été colorisées avec succès.", vbInformation, "FIN D'OPERATION"
On Error GoTo 0 'On annule le branchement vers de gestion d'erreur
'On fait le ménage
Set oRangeToScan = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Exit Sub
'Séquence de traitement des erreurs
Gestion_Err:
'On affiche l'erreur et on sort...
MsgBox "La colorisation des cellules du classeur '" & sWBName & "' a rencontré l'erreur suivante :" & vbCrLf _
& Err & "-" & Err.Description, vbCritical, "IMPOSSIBLE DE POURSUIVRE LE TRAITEMENT"
'On fait le ménage
On Error GoTo 0 'On annule le branchement vers de gestion d'erreur
Set oRangeToScan = Nothing
Set oSheet = Nothing
Set oWB = Nothing
End Sub