Traiter les commentaires des cellules

Retour vers Excel

Remplir automatiquement et définir le style des commentaires des cellules dans Excel. Les explications du code sont sur les images et dans le fichier exemple. Voici le résultat :

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    'je désigne 3 variables, les noms importe peu
    'par contre le type est important
    Dim Var As Range, Var1 As Range, c As Integer
    'on doit boucler même si une seule cellule est à considérer
    'car Target peut aussi bien contenir $D$3 que $D$3:$D
    For Each Var In Range(Target.Address)
    'je détermine le type de donnée que contient target
    'ça peut être un chiffre, un caractère, une date, autre
    'comme je ne veux que traiter les chiffres, il est important
    'd'obtenir ce paramètre, sinon ça bug dans la formule de
    'multiplication, forcément. On ne multiplie pas une lettre
    c = VarType(Var)
    'ensuite, il me faut l'adresse de la cellule, pour ne
    'traiter que la colonne D et aussi pour paramètrer
    'le commentaire correspondant, si je traite D3, je dois
    'bien sûr traiter le commentaire de D3 et pas de D6
    'Var = CStr(Target.Address)
    'ici, il faut que je prévois le cas où on remet la cellule à blanc,
    If Var = "" Then
    'il faut prévoir une seconde boucle pour nettoyer les commentaires
    For Each Var1 In Range(Target.Address)
    ' j'enlève le commentaire tout simplement
    ActiveSheet.Range(Var1.Address).ClearComments
    Next
    'et je sors de la procédure, je n'ai plus rien à y faire
    Exit Sub
    End If 'si la cellule est de type chiffre, bon là je renvois vers l'aide
    'places toi sur le mot VarType (plus haut), fais F1
    'tu verras que 2 est un integer, 6 un double, etc
    'je teste aussi si dans l'adresse de target, si j'ai la lettre D
    'pour que notre procédure ne traite que cette colonne
    If c > 2 And c < 6 And Mid(Var.Address, 2, 1) = "D" Then
    'j appelle la macro mise dans le module et je lui transmets Var
    Call Macro_commentaire2(Var)
    Else 'si cela ne correspond pas, je nettoie les commentaires
    'si on arrive jusqu ici, remarques que la procédure va
    'se terminer toute seule
    ActiveSheet.Range(Var.Address).ClearComments
    End If
    Next
End Sub

Sub Macro_commentaire(Var)
    'ici on entre dans la procédure et l'on est
    'accompagné avec notre adresse Var, exemple $D$4
    Dim Montant_Euro As String, Montant_FB As String
    'on remplit la variable avec le contenu de Var
    Montant_Euro = Var
    'on fait le calcul on formate le résultat à 2 décimales
    Montant_FB = Format((Montant_Euro * 40.3399), "###0.00")
    'on doit enlever éventuellement un ancien commentaire
    'avant de pouvoir le remplacer sinon bug assuré
    ActiveSheet.Range(Var.Address).ClearComments
    'on ajoute le commentaire à la cellule , enfin !
    ActiveSheet.Range(Var.Address).AddComment "Montant en FB: " & Chr(13) _
    & CStr(Montant_FB) & " FB"
    'on formate le commentaire, d'abord la couleur exemple 3=rouge, 5=bleu
    ActiveSheet.Range(Var.Address).Comment.Shape.TextFrame.Characters.Font.ColorIndex = 3
    'on place en gras
    ActiveSheet.Range(Var.Address).Comment.Shape.TextFrame.Characters.Font.Bold = True
    'on place en italique, pourquoi pas
    ActiveSheet.Range(Var.Address).Comment.Shape.TextFrame.Characters.Font.Italic = True
    'on place en taille 14, pour les mal-voyants, ce qui est louable
    ActiveSheet.Range(Var.Address).Comment.Shape.TextFrame.Characters.Font.Size = 14
    ActiveSheet.Range(Var.Address).Comment.Shape.Height = 40
    ActiveSheet.Range(Var.Address).Comment.Shape.Width = 120
End Sub

Sous Excel 97

Sous Excel 97, on peut rencontrer quelques problèmes car il ne semble pas reconnaître une recopie vers le bas comme un changement, et la macro ne se déclenche pas. Comme on finira par déplacer le curseur après une recopie, ne fût-ce que pour faire disparaître la sélection, on peut travailler sur l'événement "change" en adaptant quelque peu le code

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
  Dim var As Range, Var1 As Range, c As Integer
  If Mid(Target.Address, 2, 1) = "D" Then
    For Each var In Range("d:d")
      c = VarType(var)
      If var.Value <> "" Then
        ActiveSheet.Range(var.Address).ClearComments
        If c > 2 And c < 6 And Mid(var.Address, 2, 1) = "D" Then
           Call Macro_commentaire(var)
        Else
           ActiveSheet.Range(var.Address).ClearComments
        End If
      End If
    Next
  End If
End Sub

Sub Macro_commentaire(var)
  Dim Montant_Euro As String, Montant_F As String
  Montant_Euro = var
  Montant_F = Format((Montant_Euro * 6.55957), "##,##0.00")
  ActiveSheet.Range(var.Address).ClearComments
  ActiveSheet.Range(var.Address).AddComment "Montant en F : " & Chr(13) & CStr(Montant_F) & "F"
  ActiveSheet.Range(var.Address).Comment.Shape.TextFrame.Characters.Font.ColorIndex = 3
  ActiveSheet.Range(var.Address).Comment.Shape.TextFrame.Characters.Font.Bold = True
  ActiveSheet.Range(var.Address).Comment.Shape.TextFrame.Characters.Font.Italic = True
  ActiveSheet.Range(var.Address).Comment.Shape.TextFrame.Characters.Font.Size = 14
  ActiveSheet.Range(var.Address).Comment.Shape.Height = 40
  ActiveSheet.Range(var.Address).Comment.Shape.Width = 120
End Sub

Comment compter les cellules équipées de commentaires

Sub CompterLesCommentaires()
  Dim compte As Integer, cmt As Comments
  Dim c As Comment
  Set cmt = Worksheets(1).Comments
  For Each c In cmt
    compte = compte + 1
  Next
  MsgBox compte
End Sub

Tester la présence d'un commentaire sur les cellules

Sub PresenceCommentaires()
  Dim c As Range
  For Each c In Range("C1:C10") 'plage de recherche
    If Not (c.Comment Is Nothing) Then 'si le commentaire n'est pas rien
      MsgBox c.Address 'affiche l'addresse de la cellule, mais on peut mettre n'importe quoi comme code
    End If
  Next
End Sub

Cliquez ici pour télécharger le fichier exemple

FIN

Avertissement