Ce bout de VB fonctionne à la première exécution après avoir ouvert le classeur. Le fichier est bien renommé et placé à l'endroit voulu.
A partir de la seconde exécution, le fichier doc n'est pas renommé, pas fermé ...Pourtant les variables sont ok!!!

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Sub EcritPV_Levage()
   'Document PV_LEVAGE.doc contenant les signets: "TOTOA" à "TOTOj"
    'Renseigner ce doc depuis une base de donnée xls
Dim LePV As String
    Dim ObjWord As Word.Application
    Dim LeDocWord As Word.Document
    Dim vRefPv
    Dim NumLg
    Dim vSignet0, vSignet1, vSignet2, vSignet3, vSignet4, vSignet5, vSignet6, vSignet13, _
        vSignet7, vSignet8, vSignet9, vSignet10, vSignet11, vSignet12, vNewNom, vChemin As String
    vChemin = ""
On Error Resume Next
    
vChemin = ActiveWorkbook.Path & "\"
Style = vbYesNo + vbQuestion

Title = "VALIDATION DU PV A EDITER"


Sheets("PV_LEVAGE").Activate
vRefPv = InputBox(Prompt:="Taper la valeur recherchée. ")
Cells.Find(What:=(vRefPv), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder _
:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate
With Application.ActiveCell
    NumLg = .Row
Msg = "Créer un PV avec les infos de la ligne N° " & NumLg
End With
    ActiveCell.EntireRow.Select
    
    Application.ScreenUpdating = True

    réponse = MsgBox(Msg, Style, Title)

If réponse = vbYes Then
 
    vSignet0 = ActiveCell.Offset(0, 0).Value
    vSignet1 = ActiveCell.Offset(0, 1).Value
    vSignet2 = ActiveCell.Offset(0, 2).Value
   
' vNewNom futur nom du fichier .doc
    vNewNom = "PV_" & (vSignet0) & (vSignet1) & ".doc"

        LePV = ThisWorkbook.Path & "\PV_Original.doc"
    
    Set ObjWord = CreateObject("Word.Application")
        

    Set LeDocWord = ObjWord.Documents.Open(LePV)
ObjWord.Visible = True


With LeDocWord

        'Le nom du signet dans le document word est ici "TOTOA"
            .Bookmarks("TOTOA").Range.Text = vSignet0
        'Le nom du signet dans le document word est ici "TOTOB"
            .Bookmarks("TOTOB").Range.Text = vSignet1
            .Bookmarks("TOTOC").Range.Text = vSignet2
            .Bookmarks("TOTOD").Range.Text = vSignet3
             .Bookmarks("TOTON").Range.Text = vSignet13 & " / "
End With
  
  ChangeFileOpenDirectory vChemin 'C'est là que ça ne va plus
    ActiveDocument.SaveAs Filename:=vNewNom

     ActiveDocument.Close wdDoNotSaveChanges
  
    ObjWord.Quit
 
 
'retour excel et marque le document comme édité
    ActiveCell.Value = "Edité le " & Date

Application.ScreenUpdating = True
'désélection de la ligne et retour haut de la feuille
    End If
    Application.Goto Reference:=ActiveSheet.Range("A2"), Scroll:=True
    ActiveWorkbook.Save

End Sub
Qui peut éclairer ma lanterne?
Merci