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