Insérer plusieurs commentaires différents à une plage de cellules
Bonjour,
J'ai un tableau rempli avec des code de projets. Pour simplifier ma demande, j'opte pour l'exemple suivant :
La plage de cellule concernée A1:A10, j'ai 3 projets avec des codes différents ; projet 1 = 1 , projet 2 = 2 , projet 3 = 3. Je veux automatiser les commentaires sur ces cellules et j'ai du mal à mettre la condition ( If .... Then .... Elese) sachant qu'il ya des cellules vides où je veux que rien n’apparaît. Le code qui fonctionne pour un même commentaire est ci-dessus.
Merci par avance de votre aide
Sub test()
Dim Message As String
Dim Rg As Range, C As Range
'contenu du commentaire à adapter
Message = "Projet1"
With Worksheets("Feuil1")
Set Rg = .Range("A1:A10")
End With
For Each C In Rg
AjoutCommentaire C, Message
Next
End Sub
'-----------------------------------------------
Sub AjoutCommentaire(C As Range, Message As String)
Dim Commentaire As Comment
With C
.ClearComments
Set Commentaire = .AddComment
End With
With Commentaire
.Visible = False
.Text Message
'Caractéristique du format du commentaire
With .Shape.OLEFormat.Object
.Font.Name = "Arial"
.Font.Size = 12
.Font.Bold = True
.Font.ColorIndex = 3
'.Height = 20.5
'.Width = 70.5
'Désactive la ligne suivante pour obtenir la
'grandeur du cadre du commentaire par défaut.
.AutoSize = True
End With
End With
End Sub
Bonjour,
si dans ta colonne A tu les codes projet
Sub test()
Dim Message As String
Dim Rg As Range, C As Range
'contenu du commentaire à adapter
Message = "Projet"
With Worksheets("Feuil1")
Set Rg = .Range("A1:A10")
End With
For Each C In Rg
If C.Value <> "" Then AjoutCommentaire C, Message & " " & C.Value
Next
End SubMerci
Il me reste juste à automatiser les commentaires :
- Si la valeur de la cellule = 1 -----> le commentaire = projet 1
- Si la valeur de la cellule = 2 -----> le commentaire = projet 2
- Si la valeur de la cellule = 3 -----> le commentaire = projet 3
Je vous remercie
Bonjour,
si dans ta colonne A tu les codes projet
Sub test() Dim Message As String Dim Rg As Range, C As Range 'contenu du commentaire à adapter Message = "Projet" With Worksheets("Feuil1") Set Rg = .Range("A1:A10") End With For Each C In Rg If C.Value <> "" Then AjoutCommentaire C, Message & " " & C.Value Next End Sub
Du coup, c'est bon, j'ai réussi
Merci infiniment de votre aide et de votre retour rapide
Excellente journée !!
Bonjour,
si dans ta colonne A tu les codes projet
Sub test() Dim Message As String Dim Rg As Range, C As Range 'contenu du commentaire à adapter Message = "Projet" With Worksheets("Feuil1") Set Rg = .Range("A1:A10") End With For Each C In Rg If C.Value <> "" Then AjoutCommentaire C, Message & " " & C.Value Next End Sub