Mettre une partie de la phrase en évidence

gosselien

XLDnaute Barbatruc
Hello à tous,

petit souci pour une cellule avec formule:

="Le Bailleur loue au Preneur le logement du "& TEXTE(D14;"jjjj jj mmm aaaa") & " au " & TEXTE(D15;"jjjj jj mmm aaaa") & " pour " & D8 & " adultes, "

j'aurais voulu mettre la date (contenue en D14 - D15 - D8 dans ce cas) en couleur ou en gras ?
Si ce n'était pas une formule, on saurait mettre une partie de la phrase en gras, mais ici , comme ça commence par un "=" c'est donc une formule et il me semble impossible de colorer la partie voulue sauf , et c'est un peu du chipotage, on met le début dans une cellule, la suite dans celle à droite et ainsi de suite.

Merci de votre aide (VBA ou autre)

ps: il est possible que je pose la question sur un autre forum, mais je le signalerai bien sur, ça me donne simplement + de chances d'avoir une réponse et parfois meilleure d'un côté que de l'autre/

P.
 

phlaurent55

XLDnaute Barbatruc
Salut cher compatriote,

J'ai la solution,ce n'est pas difficile à réaliser mais je dois m'absenter car la belle-mère me réclame en urgence.

Promis, tu auras la solution demain en matinée

À+
Philippe
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour gosselien :), phlaurent55 ;),

J'ai une solution et la belle-mère ne me réclame pas d'urgence, donc je la télécharge de ce pas (la solution pas la belle-mère ! ) :D.

Voir la macro dans le module de code associé à Feuil1.
 

Fichiers joints

Dernière édition:

gosselien

XLDnaute Barbatruc
Re à tous,

je vais tester ça :)
Heureusement; il n'y a pas beaucoup de zones à mettre en évidence , mais je vois que comme ça c'est possible; j'étais parti sur une copie de la phrase en valeur et puis colorer ou mettre en gras la zone voulue.
Je vais adapter cela à mon fichier réel.
Merci mapomme ... et je vais voir ce que propose mon compatriote
P.
 

job75

XLDnaute Barbatruc
Bonsoir gosselien, Philippe, mapomme,

Une autre solution :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim p1%, p2%, p3%, p4%
Application.EnableEvents = False
With [D17] 'cellule à adapter
  .Formula = "=""Le Bailleur loue au Preneur le logement du ""&TEXT(D14,""jjjj jj mmmm aaaa"")&"" au ""&TEXT(D15,""jjjj jj mmmm aaaa"")&"" pour ""&D8&"" adultes,"""
  .Value = .Value 'supprime la formule
  p1 = InStr(.Value, "du"): p2 = InStr(p1, .Value, "au"): p3 = InStr(.Value, "pour"): p4 = InStr(.Value, "adult")
  .Characters(p1 + 3, p2 - p1 - 4).Font.Bold = True: .Characters(p1 + 3, p2 - p1 - 4).Font.ColorIndex = 3
  .Characters(p2 + 3, p3 - p2 - 4).Font.Bold = True: .Characters(p2 + 3, p3 - p2 - 4).Font.ColorIndex = 3
  .Characters(p3 + 5, p4 - p3 - 6).Font.Bold = True: .Characters(p3 + 5, p4 - p3 - 6).Font.ColorIndex = 3
End With
Application.EnableEvents = True
End Sub
A+
 

Fichiers joints

job75

XLDnaute Barbatruc
Re,

Ma solution précédente n'est pas fameuse car elle ne fonctionne que sur une version française.

Donc utiliser :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dat1$, dat2$, n$, p1%, p2%, p3%, p4%
Application.EnableEvents = False
dat1 = Format([D14], "dddd dd mmmm yyyy"): dat2 = Format([D15], "dddd dd mmmm yyyy"): n = [D8]
With [D17] 'cellule à adapter
  .Value = "Le Bailleur loue au Preneur le logement du " & dat1 & " au " & dat2 & " pour " & n & " adultes,"
  p1 = InStr(.Value, "du"): p2 = InStr(p1, .Value, "au"): p3 = InStr(.Value, "pour"): p4 = InStr(.Value, "adult")
  .Characters(p1 + 3, p2 - p1 - 4).Font.Bold = True: .Characters(p1 + 3, p2 - p1 - 4).Font.ColorIndex = 3
  .Characters(p2 + 3, p3 - p2 - 4).Font.Bold = True: .Characters(p2 + 3, p3 - p2 - 4).Font.ColorIndex = 3
  .Characters(p3 + 5, p4 - p3 - 6).Font.Bold = True: .Characters(p3 + 5, p4 - p3 - 6).Font.ColorIndex = 3
End With
Application.EnableEvents = True
End Sub
A+
 

Fichiers joints

phlaurent55

XLDnaute Barbatruc
Re-bonjour à tous

Mauvaise nouvelle, Toujours vivante, toujours debout, .....................

Plus sérieusement, voici le fichier que j'avais du abandonner hier

......... et qui tient compte du singulier/pluriel en fonction du nombre d'adulte(s)

à+
Philippe
 

Fichiers joints

gosselien

XLDnaute Barbatruc
Bonjour et merci à tous !!!

Je vais regarder dans ces différentes propositions ce qui sera applicable à ma demande , mais je suis toujours surpris par la diversité des réponses et leur exactitude :)

P.
edit pour mon compatriote: je l'offrirais bien volontiers mais perso, je ne bois pas d'Orval qui a un très grand succès chez nous (info pour les non belges)
 

job75

XLDnaute Barbatruc
Bonjour gosselien, le forum,

Encore un p'tit coup pour bien commencer la journée :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dat1$, dat2$, n$, p1%, p2%, p3%
dat1 = Format([D14], "dddd d mmmm yyyy"): dat2 = Format([D15], "dddd d mmmm yyyy"): n = [D8]
dat1 = Replace(dat1, " 1 ", " 1er "): dat2 = Replace(dat2, " 1 ", " 1er ")
Application.EnableEvents = False
With [D17] 'cellule à adapter
  .Value = "Le Bailleur loue au Preneur le logement du " & dat1 & " au " & dat2 & " pour " & n & " adulte" & IIf(Val(n) > 1, "s", "") & ","
  p1 = InStr(.Value, dat1): p2 = InStr(p1 + 1, .Value, dat2): p3 = InStr(p2 + Len(dat2), .Value, n)
  If Len(dat1) Then .Characters(p1, Len(dat1)).Font.Bold = True: .Characters(p1, Len(dat1)).Font.ColorIndex = 3
  If Len(dat2) Then .Characters(p2, Len(dat2)).Font.Bold = True: .Characters(p2, Len(dat2)).Font.ColorIndex = 3
  If Len(n) Then .Characters(p3, Len(n)).Font.Bold = True: .Characters(p3, Len(n)).Font.ColorIndex = 3
End With
Application.EnableEvents = True
End Sub
Edit : voyez si vous déclarez n& au lieu de n$...

Bon week-end.
 

Fichiers joints

Dernière édition:

Discussions similaires


Haut Bas