XL 2019 cellule Excel vers signet word : garder la mise en forme

[Stateaid]

Bonjour,

apres trois jours á me casser la tete, je tente de vous soumettre une question. J´ai trouver un projet excellent sur un forum (peut etre ici je ne sais plus) qui prend le contenu des cellules d´une ligne pour les mettre á la place de signets dans un fichier créé á partir d´un fichier template. Les signets restent sur les fichiers créés ce qui est aussi excellent.

Le seul soucis c´est que je souhaiterai que la mise en forme á l´intérieur de la cellule soit aussi reproduite. Exemple pour "je mange du pain", je souhaiterais que cela soit bien reproduit avec seulement mange en gras.

voici le code :

Option Explicit
Sub CréationFicheBase()
'nécéssite d'activer la référence Microsoft Word xx.x Object Library
Dim WordApp As Word.Application, WordDoc As Word.Document
Dim i&, j&, pos&, NomDoc$, s As Object
Application.ScreenUpdating = 0
Set WordApp = CreateObject("word.application")
On Error Resume Next

For j = 3 To [A65536].End(xlUp).Row
NomDoc = ThisWorkbook.Path & "\" & Cells(j, 1) & ".doc"
Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\" & "Template.doc")   'A Modifier
WordDoc.SaveAs2 NomDoc
For i = 1 To 23
  Set s = WordDoc.Bookmarks("Signet" & i)
  If s Is Nothing Then GoTo Suite
  WordDoc.Activate
  s.Select
   WordApp.Options.ReplaceSelection = True
  If Cells(j, i) <> "" Then
    WordApp.Selection.TypeText Cells(j, i)
    pos = WordApp.Selection.Range.End
    Set s = WordDoc.Range(pos - Len(Cells(j, i)), pos)
  Else
    WordApp.Selection.TypeText " "
    pos = WordApp.Selection.Range.End
    Set s = WordDoc.Range(pos - 1, pos)
  End If
  WordDoc.Bookmarks.Add "Signet" & i, s
  On Error GoTo 0
Suite:
Next i
WordDoc.Close True
Next j
WordApp.Quit
Beep
Application.ScreenUpdating = -1
End Sub

Peut etre que la solution est toute bete, ou pas...

voici les fichiers (seule la fonction création fichier m´intéresse)