Citation :
'***
Crit_FLgn = vbLf 'dans le shape commentaire, terminaison naturelle
'de fin de ligne sauf la dernière...
Modulo = 2 'style pseudo bistre
Coul_F_Com = RGB(250, 250, 245) 'couleur de remplissage shape commentaire
Coul_Lgn_Imp = RGB(10, 70, 60) 'couleur N°ligne impaire vs Modulo
Coul_Lgn_Pair = RGB(139, 61, 38) 'couleur N°ligne paire vs Modulo
Crit_Chaine = "couleurs différentes" 'mumuse sur chaîne
'Target à passer en paramètre de procédure
Cible = "A1"
'texte d'essais. Variable à passer en param de procédure
Mon_Text = Crit_FLgn & "Présentation de commentaire" & Crit_FLgn _
& "J'ai fait une p'tite appli excel en VBA" & Crit_FLgn & _
"et je voudrais rajouter un commentaire (bon, ça c'est bon)" & Crit_FLgn & _
"avec des couleurs différentes pour certains mots du texte." & Crit_FLgn & _
"Je m 'explique, ce comment permet de lister les valeurs de différentes cellules" _
& Crit_FLgn & "et je voudrais une couleur par ligne." & vbLf _
& vbLf & "Voilà déjà mon bout de code :"
'***
'init du commentaire pour le terminer avec Crit_FLgn afin de prendre en compte
'la position de fin du texte dans le Tabl_Pos_Crit_Lgn (split)
Mon_Text = Mon_Text & Crit_FLgn
Pos = InStr(1, Mon_Text, Crit_FLgn, vbTextCompare)
Pos_Crit_Lgn = "0" 'voir plus loin 'Val(Tabl_Pos_Crit_Lgn(Num_Lgn - 1)) + 1'
Do While Pos > 0
Pos_Crit_Lgn = Pos_Crit_Lgn & "," & Pos 'Positions csv
Pos = InStr(Pos + 1, Mon_Text, Crit_FLgn, vbTextCompare)
Loop
Tabl_Pos_Crit_Lgn = Split(Pos_Crit_Lgn, ",", -1, vbTextCompare)
'retire Crit_FLgn ajouté précédemment dans le texte du commentaire
'pour les besoins du split avant de l'affecter au shape comment
Mon_Text = Left(Mon_Text, Len(Mon_Text) - 1)
'Fin init, traite le commentaire
With Range(Cible)
'efface le commentaire s'il existe sinon error
On Error Resume Next
.Comment.Delete
'désactive tout handler d'erreur de cette procédure
On Error GoTo 0
'affecte le commentaire à cible
.AddComment (Mon_Text)
'sélectionne l'objet Shape de cible
.Comment.Visible = True 'obligé
.Comment.Shape.Fill.ForeColor.RGB = Coul_F_Com
.Comment.Shape.Select
'Met en forme l'objet shape commentaire
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.Orientation = xlHorizontal
.AutoSize = True
'formate des lignes de texte de l'objet shape
Cpt_Lgn_Vide = 0
For Num_Lgn = LBound(Tabl_Pos_Crit_Lgn) + 1 To _
UBound(Tabl_Pos_Crit_Lgn)
'lgn courante vide ?
If Mid(Mon_Text, _
Val(Tabl_Pos_Crit_Lgn(Num_Lgn - 1)) + 1, _
Val(Tabl_Pos_Crit_Lgn(Num_Lgn)) _
- Val(Tabl_Pos_Crit_Lgn(Num_Lgn - 1)) - 1) _
<> "" Then
With .Characters(Val(Tabl_Pos_Crit_Lgn(Num_Lgn - 1)) + 1, _
Val(Tabl_Pos_Crit_Lgn(Num_Lgn)) _
- Val(Tabl_Pos_Crit_Lgn(Num_Lgn - 1)) - 1).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
'.Strikethrough,.Superscriptn,.Subscript,.OutlineFont
'.Shadow,.Underline ...
'style pseudo bistre sur les lignes de texte de l'objet texte
If (Num_Lgn + Cpt_Lgn_Vide) Mod Modulo = 0 Then
macoul = Coul_Lgn_Pair
Else
macoul = Coul_Lgn_Imp
End If
.Color = macoul
End With
'pour m'amuser
'couleurs psychédéliques sur une chaîne Crit_Chaine
Lgn_Test = Mid(Mon_Text, Val(Tabl_Pos_Crit_Lgn(Num_Lgn - 1)) _
+ 1, Val(Tabl_Pos_Crit_Lgn(Num_Lgn)) _
- Val(Tabl_Pos_Crit_Lgn(Num_Lgn - 1)) - 1)
Pos = InStr(1, Lgn_Test, Crit_Chaine, vbTextCompare)
If Pos > 0 Then
For k = Tabl_Pos_Crit_Lgn(Num_Lgn - 1) + Pos To _
Tabl_Pos_Crit_Lgn(Num_Lgn - 1) + Pos + _
Len(Crit_Chaine)
.Characters(k, 1).Font.Color = Coul_F_Com - k * 2000
Next k
End If
Else
'correction bistre pour ligne vide
Cpt_Lgn_Vide = Cpt_Lgn_Vide + 1
End If
Next Num_Lgn
End With
'libère l'affichage
.Comment.Visible = False
End With
'***
|
...