Mise en forme d'un morceau de texte d'un commentaire

Mise en forme d'un morceau de texte d'un commentaire - VB/VBA/VBS - Programmation

Marsh Posté le 07-11-2005 à 13:20:12    

Yop,
 
J'ai fait une p'tite appli excel en VBA et je voudrais rajouter un commentaire (bon, ça c'est bon) avec des couleurs différents pour certains mots du texte.
Je m'explique, ce comment permet de lister les valeurs de différentes cellules, et je voudrais une couleur par ligne.
 
Voilà déjà mon bout de code :
 

Code :
  1. *snip*
  3.     Set db = OpenDatabase(Worksheets("Accueil" ).lblCheminBase.Caption)
  4.     Set rs = db.OpenRecordset("SELECT entrees.id, entrees.date_debut, entrees.date_fin, " & _
  5.                               "applis.code, applis.nom, " & _
  6.                               "entrees.incident, entrees.resume " & _
  7.                               "FROM entrees, applis " & _
  8.                               "WHERE entrees.appli=applis.id " & _
  9.                               "ORDER BY entrees.date_debut DESC, entrees.id DESC;", dbReadOnly)
  10.    
  11.     i = 0
  12.    
  13.     With rs
  14.         If Not .BOF Then .MoveFirst
  15.         While Not .EOF
  17. *snip, je détaille pas, mais en gros 'strActions = strActions + nouvelle ligne'*               
  19.                 With .Cells(OFFSETY + i, OFFSETX + 4).AddComment
  20.                     .Visible = False
  21.                     .Text strActions
  22.                 End With
  23.                
  24.             End With
  25.             i = i + 1
  26.             .MoveNext
  27.         Wend
  28.     End With


---------------
Nicolede @ Illidan (drood spé aspirine)
Reply

Marsh Posté le 07-11-2005 à 13:20:12   

Reply

Marsh Posté le 09-11-2005 à 13:40:54    

A la place de la sieste, par curiosité, un petit bout de code, à adapter.
Tout s'articule sur .Characters(start, length)
La méthode adoptée consiste à se créer un tableau de position de caractères de fin de ligne contenus dans le texte du commentaire à traiter puis, après avoir affecté ce dit commentaire à la cible, modifier la couleur aux lignes définies par le tableau.
Ici une méthode pseudo bistre est utilisée.
La modification de couleur peut très bien être faite sur un mot, voir une bibliothèque de mots, qui seraient contenus dans le texte commentaire à traiter. Genre: déficit an-1 en rouge et gras et demandes d'augmentation de salaire en vert (espoir)  :lol: ...                
 
 

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
'***

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed