dernière ligne de texte d'une cellule à mettre en gras

Question

Bonjour à toutes et à tous,

un utilisateur me demande une mise en forme particulière :
dans un tableau Excel, qui est mis à jour régulièrement, les cellules d'une colonne contiennent des lignes séparées par un retour à la ligne.

Dans chaque cellule,
la dernière ligne de texte est mise en gras.

Il serait confortable que , lorsque l'utilisateur saisit une nouvelle ligne de texte  derrière la précédente, alors :
a) la précédente dernière ligne de texte ne soit plus  en gras.
b) la nouvelle dernière ligne de texte soit mise en gras.

exemple :
la cellule contient :
A la claire fontaine,
m'en allant promener
j'ai trouvé l'eau si belle


l'utilisateur rajoute une ligne, et le résultat attendu est :
la cellule contient :
A la claire fontaine,
m'en allant promener
j'ai trouvé l'eau si belle
que je m'y suis baigné

Avez-vous une idée sur la façon la plus subtile d'automatiser ce fonctionnement ?
D'avance je vous en remercie.
Cordialement,
DenPhil

dlt-pan · Answer

bonjour,
j'ai ce petit bout de macro qui fonctionne mais celà impose de renter les textes en doublecliquant sur la cellule.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim text, ntext As String
Dim l, nl As Integer
text = ActiveCell
l = Len(text)
ntext = InputBox("nouveau texte")
nl = Len(ntext)
ActiveCell.FormulaR1C1 = text & Chr(10) & ntext
Selection.Font.Bold = False
With ActiveCell.Characters(Start:=l + 1, Length:=nl + 1).Font
        .FontStyle = "Gras"
End With
End Sub

ccm81 · Answer

Bonjour

Option Explicit

' plages à traiter - à modifier selon la configuration
Const plage1 = "A1:A10"
Const plage2 = "C1:C10"

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pl As Range, nbvblf As Long, rvblf As Long, s As String
' compléter avec les plages à traiter
Set pl = Union(Range(plage1), Range(plage2))
If Not Intersect(Target, pl) Is Nothing Then
  s = Target.Value
  s = StrReverse(s)
  rvblf = InStr(1, s, vbLf)
  If rvblf = 0 Then
    Target.Font.Bold = True
  Else
    rvblf = Len(s) - rvblf + 1
    Target.Characters(Start:=1, Length:=rvblf - 1).Font.Bold = False
    Target.Characters(Start:=rvblf + 1, Length:=Len(s) - rvblf).Font.Bold = True
  End If
End If
End Sub
Un exemple
https://www.cjoint.com/?3Ltp1WeStks 

Cdlmnt

Dernière ligne de texte d'une cellule à mettre en gras

2 réponses

Discussions similaires

Newsletters