VBA et Word: mise en page

Bonjour
voila l'intégralité du sub dans lequel j'ai le probleme: le code marche bien
mais, la mise en page faite dans word (taille police et gras) ne marche QUE
la pemière fois, si j'applique le sub a un autre enregistrement, ca marche
mais pas de police gras !!! je dois relancé l'appli pour avoir la mise en
page!

merci d'avance
philippe



Private Sub Commande15_Click()
On Error GoTo HandleErr

On Error Resume Next
Dim W_App As New Word.Application
Dim rsts As Recordset
Dim a, aa, b, c, d, e, f, g, k, h, z, L1, L2, L3, N As String
Dim n1, n2, n3, Coef, PRIX, tot As Double
Dim s As Double
Dim rs As Recordset
DoCmd.SetWarnings False

s = Me.N°affaire

With W_App
.Visible = True
.Documents.Open SaveFile2
With W_App.ActiveDocument.Range
Set db = Application.CurrentDb
Set rsts = db.OpenRecordset("S_affaire+", dbOpenDynaset)
rsts.MoveFirst
While rsts!N°affaire <> s
If rsts.EOF Then
rsts.MoveNext
Else
End If
rsts.MoveNext
Wend
W_App.ActiveDocument.Bookmarks("contact").Select
a = rsts!Contact

W_App.Selection.InsertAfter a

W_App.ActiveDocument.Bookmarks("devis").Select
b = rsts!devis
W_App.Selection.InsertAfter b & " "
W_App.Selection.Select
With Selection
.Font.Bold = True
.Font.Size = 12
End With
W_App.ActiveDocument.Bookmarks("affaire").Select
c = rsts!txtAffaire
W_App.Selection.InsertAfter c & " "
W_App.Selection.Select
With Selection
.Font.Bold = True
.Font.Size = 12
End With

Coef = rsts!Coefficient
Set rsts = Nothing
Set db = Nothing

Set db = Application.CurrentDb
Set rsts = db.OpenRecordset("PrixGlobalSom2", dbOpenDynaset)
rsts.MoveFirst
While rsts!N°affaire <> s
If rsts.EOF Then
rsts.MoveNext
Else
End If
rsts.MoveNext
Wend
PRIX = rsts![total affaire]
Set rsts = Nothing
Set db = Nothing
W_App.ActiveDocument.Bookmarks("p").Select
tot = PRIX * Coef
Prix2 = Format(tot, "###0.00")
With Prix2
.Font.Bold = True
.Font.Size = 12
End With
W_App.Selection.InsertAfter Prix2
W_App.Selection.Select
With Selection
.Font.Bold = True
.Font.Size = 12
End With

Set db = Application.CurrentDb
Set rsts = db.OpenRecordset("R_EtatWord", dbOpenDynaset)
rsts.MoveFirst
If rsts.EOF Then
GoTo sortie
Else
End If
z = rsts!N°affaire
W_App.ActiveDocument.Bookmarks("N").Select
Do

n1 = rsts!N°fonction1
n2 = rsts!N°fonction2
n3 = rsts!N°fonction3

If rsts!N°fonction2 = aa Then
GoTo nn3
Else

End If
If rsts!N°fonction1 = z Then
GoTo n2
Else

W_App.Selection.InsertRowsBelow
W_App.Selection.MoveLeft
W_App.ActiveDocument.Bookmarks.Add ("N")
End If
'''''''''''''''''''''''''''debut
N1'''''''''''''''''''''''''''''''''''
W_App.ActiveDocument.Bookmarks("N").Select
If Me.Cocher20 = True Then
d = rsts!x_fonction1 & " " & rsts!CommentaireN
x = rsts!x_fonction1
Else
d = rsts!x_fonction1
x = rsts!x_fonction1
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Me.Cocher18 = True Then
e = rsts!Commentairern
Else
e = ""
End If

n3:
If Me.Cocher16 = False Then
k = ""
Else
k = rsts!x_rubrique1
End If

n1:
f = d & " /" & k & "/" & e


W_App.Selection.InsertAfter f
W_App.Selection.Select
With Selection
.Font.Bold = True
.Font.Size = 12
End With

'''''''''''''''''''debut N2''''''''''''''''''''''''''''''
n2:
If n2 <> nul Then
W_App.Selection.InsertRowsBelow
W_App.Selection.MoveLeft
W_App.ActiveDocument.Bookmarks.Add ("Nr")

W_App.ActiveDocument.Bookmarks("Nr").Select
v = rsts!x_fonction2
If Me.Cocher20 = True Then
g = rsts!x_fonction2 & " " & rsts!CommentaireN1
Else
g = rsts!x_fonction2
End If
If Me.Cocher18 = True Then
N = rsts!Commentairern1
Else
N = ""
End If
If Me.Cocher16 = True Then
h = rsts!x_rubrique2
Else
h = ""
End If

i = x & " " & g & " /" & h & " " & N
'gestion des tabulation (espaces)N3
W_App.Selection.InsertAfter " " & i
W_App.Selection.Select
With Selection
.Font.Bold = False
.Font.Size = 11
End With
Else
End If
'''''''''''''''''''''''fin *N2'''''''''''''''''''''''''''
nn3:
If rsts!N°fonction3 <> nul Then
W_App.Selection.InsertRowsBelow
W_App.Selection.MoveLeft
W_App.ActiveDocument.Bookmarks.Add ("Nrr")

W_App.ActiveDocument.Bookmarks("Nrr").Select
If Me.Cocher20 = True Then
m = rsts!x_fonction3 & " " & rsts!CommentaireN2
Else
m = rsts!x_fonction3
End If
If Me.Cocher18 = True Then
N = rsts!Commentairern2
Else
N = ""
End If
If Me.Cocher16 = True Then
h = rsts!x_rubrique3
Else
h = ""
End If

p = x & " " & v & " " & m & " /" & h & "/" & N
'gestion des tabulation (espaces)N3
W_App.Selection.InsertAfter " " & p
W_App.Selection.Select
With Selection
.Font.Bold = False
.Font.Size = 10
End With
Else
End If

SortieN1:
f = ""
i = ""
p = ""
z = rsts!N°fonction1
aa = rsts!N°fonction2
rsts.MoveNext
If rsts.EOF Then
GoTo sortie
End If
Loop

sortie:
End With
End With
W_App.ActiveDocument.SaveAs SaveFile

Set rsts = Nothing
Set db = Nothing
Set W_App = Nothing
ExitHere:
Exit Sub