Changer couleur indicateur commentaire

Bonsoir,

j'ai trouvé sur votre site une procédure permettant de changer la couleur de l'indicateur de commentaire sur l'ensemble des cellules (voir Macro dans fichier joint).

J'ai essayé sans succès d'adapter cette procédure pour pouvoir l'appliquer sur une seule cellule en fonction de la valeur d'un paramètre.

Pouvez-vous m'aider.

Merci par avance

Cdt

JMV

Bonjour,

l'adresse de cellule d'un commentaire par défaut est sur la colonne à gauche et la ligne en bas

Sub CoverCommentIndicator2()
For Each pComment In ActiveSheet.Comments
    addr1 = Range(pComment.Shape.TopLeftCell.Address).Offset(1, -1).Address
    Debug.Print ActiveCell.Address & " - " & addr1
Next
End Sub

par exemple pour insérer le shape(triangle) sur la cellule sélectionnée uniquement,

Sub CoverCommentIndicatorOnSelection()
Dim pComment As Comment
Dim addrComment As String
Dim l As Integer, t As Integer
For Each pComment In ActiveSheet.Comments
   addrComment = Range(pComment.Shape.TopLeftCell.Address).Offset(1, -1).Address
   If ActiveCell.Address = addrComment Then
    With ActiveCell
      l = .Left + .Width - 5
      t = .Top
    End With
'    expression.AddShape(Type, Left, Top, Width, Height)
    Set pShape = ActiveSheet.Shapes.AddShape(msoShapeRightTriangle, l, t, 5, 5)
     With pShape
        .Flip msoFlipVertical
        .Flip msoFlipHorizontal
        .Fill.ForeColor.SchemeColor = 12
        .Fill.Visible = msoTrue
        .Fill.Solid
        .Line.Visible = msoFalse
     End With
   End If
Next
End Sub

Bonjour,

Exemple en PJ

Cache le triangle rouge de commentaire de la cellule si la cellule B3 contient un nombre >100

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Target.Comment Is Nothing And Target.Address = "$B$3" Then
   If Target.Value < 100 Then
       On Error Resume Next
       ActiveSheet.Shapes("cmt" & Target.Address).Delete
       On Error GoTo 0
     Else
        On Error Resume Next
        With ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
          Left:=Target.Left + Target.Width - 3, Top:=Target.Top + 1, Width:=3, Height:=3)
          .Fill.ForeColor.RGB = RGB(255, 255, 255)
          .Line.ForeColor.RGB = RGB(255, 255, 255)
          .IncrementRotation 180
          .Name = "cmt" & Target.Address
        End With
      End If
      On Error GoTo 0
   End If
End Sub

Ceuzin

Un grand merci pour vos réponses.

Cdt

JMV

Merci pour ce retour, au plaisir!

si le problème est résolu, s.v.p. pour clôturer le fil, cliquer sur le bouton V vert du post à coté du bouton EDITER, merci!