Discussion :

[chth26]

Bonjour,

J'ai un petit problème sur cette macro qui fonctionne trés bien lors de la première exécution, mais qui plante lors de la seconde au niveau de la ligne en gras.
Le debogeur renvoir l'erreur '462', "Le serveur distant n'existe pas ou n'est pas disponible."
De plus, si je clique sur 'annuler' lorsque la fenêtre d'enregistrement s'ouvre, le code met pas mal de temps à finir de s'exécuter.
La macro est exécutée depuis un fichier excel.

Merci de votre aide

PS : J'ai modifié le code car je ne peux le communiquer d'où les noms de variables.

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
81
82
83
84
85
86
87
Public Sub Macro()
    'Chemins d'accés
    Dim Template_Path As String, Folder_Path As String, ExcelFileDoc1_Path As String
    Folder_Path = ThisWorkbook.Worksheets("Conf").Range("B2")
    ExcelFileDoc1_Path = ThisWorkbook.Worksheets("Conf").Range("B1")
    Template_Path = ThisWorkbook.Worksheets("Conf").Range("B8")
    
    'Sélection du répertoire
    Application.FileDialog(msoFileDialogFolderPicker).InitialFileName = Folder_Path
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Select Folder"
    Application.FileDialog(msoFileDialogFolderPicker).AllowMultiSelect = False
    If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
        Folder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
    Else
        Enda
    End If

    Dim ListeFiles As New Collection, FilesInFolder As String
    FilesInFolder = Dir(Folder & "\")
    Do While FilesInFolder <> ""
        ListeFiles.Add FilesInFolder
        FilesInFolder = Dir()
    Loop
    
    'Recherche du fichier ExcelFileDoc2
    For Each ExcelFileDoc2 In ListeFiles
        If (InStr(1, ExcelFileDoc2, "Excel_doc2") <> 0) And (InStr(1, ExcelFileDoc2, ".xls") <> 0) Then
            Exit For
        End If
    Next
               
    'Ouverture du fichier Word
    Dim Wordapp As New Word.Application, WordDoc As Document
    Set WordDoc = Wordapp.Documents.Open(ThisWorkbook.path & "\" & Template_Path, ReadOnly:=False)
    Wordapp.Visible = True
        
    'Ouverture fichier ExcelDoc1
    Dim ExcelDoc1 As New Workbook
    Set ExcelDoc1 = Workbooks.Open(ExcelFileDoc1_Path, ReadOnly:=True)
    Windows(ExcelDoc1.Name).Visible = True
    
    'Ouverture du fichier ExcelDoc2
    Dim ExcelDoc2 As New Workbook
    Set ExcelDoc2 = Workbooks.Open(Folder & "\" & ExcelFileDoc2, ReadOnly:=True)
    Windows(ExcelDoc2.Name).Visible = True
    
    'Récupération nom
    Dim Nom As String
    Nom = Split(Folder, " - ")(1)
    Nom = Mid(Nom, 4, 3)
    
    'Informations dans le fichier ExcelDoc1
    Dim NomCell, WordDocReferenceCell
    
    Set NomCell = ExcelDoc1.Sheets("Sheet1").Columns(1).Cells.Find(what:=Nom)
    Set WordDocReferenceCell = ExcelDoc1.Sheets("Sheet1").Cells.Find(what:="WordDoc")

    Dim Reference As String
    Reference = ExcelDoc1.Sheets("Sheet1").Cells(NomCell.Row, WordDocReferenceCell.Column)
    
    'Remplissage WORD
    WordDoc.CustomDocumentProperties.Item("A_Reference") = Reference
    SearchAndReplace "<Nom>", Nom, WordDoc
    
    'Maj des champs
    maj_champs WordDoc

    'Fermetures des fichiers
    ExcelDoc2.Close SaveChanges:=False
    ExcelDoc1.Close SaveChanges:=False

    'Sauvegarde du fichier WordDoc
    Dim rep As FileDialog
    
    Set rep = Word.Application.FileDialog(msoFileDialogSaveAs)
    rep.AllowMultiSelect = False
    rep.Title = "Enregistrer le fichier sous..."
    rep.InitialFileName = Folder & Nom
    rep.FilterIndex = 2 'format .docm
    If rep.Show = -1 Then
        WordDoc.SaveAs Filename:=rep.SelectedItems(1)
    Else
        WordDoc.Close SaveChanges:=False
        Wordapp.Quit
        Exit Sub
    End If
End Sub

[jerome.vaussenat]

Salut,

essaie de mettre un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set rep = nothing

avant le end sub

[chth26]

Merci de ta réponse.
Ca fonctionne toujours trés bien lors de la première exécution, mais cette fois le code d'erreur a changé.
Le debogeur renvoie toujours a la même ligne.

[jerome.vaussenat]

Salut,

Je ne peux pas faire tourner ton code. Donc ces conseils sont plus du ressenti que des certitudes.

Pour toutes les variables initialisées par un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

set var = ...

Mets à la fin de la macro un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set var = nothing

Cette instruction permet de décharger les dit objets de la mémoire.

On verra si cela améliore les choses.

[chth26]

Merci pour tes conseils, mais toujours pas de changements. J'ai toujours une erreur '462' de générée (ligne 75).
J'aurais tendance à penser que cela vient de la façon dont est enregistré le Word.

J'utilisais la même syntaxe pour enregistrer un fichier Excel depuis un autre fichier Excel et aucun soucis.
La seule modification est l'ajout du "Word." devant Application.FileDialog(...)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set rep = Word.Application.FileDialog(msoFileDialogSaveAs)

Edit :
J'ai simplifié le code au maximum pour que tu puisse essayer de ton coté si tu as un peu de temps.
Il faut juste spécifier le chemin d'accés d'un fichier Word dans la cellule A1 de la premiere feuille du fichier Excel.

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
Public Sub Macro()
    'Chemins d'accés
    Dim Template As String
    Template = ThisWorkbook.Worksheets("Feuil1").Range("A1")
 
    'Ouverture du fichier Word
    Dim WordApp As Word.Application, WordDoc As Document
    Set WordApp = CreateObject("Word.Application")
    Set WordDoc = WordApp.Documents.Open(Template, ReadOnly:=True)
    WordApp.Visible = True
 
    'Sauvegarde du fichier WordDoc
    Dim rep As FileDialog
    Set rep = Word.Application.FileDialog(msoFileDialogSaveAs)
    rep.AllowMultiSelect = False
    rep.Title = "Enregistrer le fichier Word sous..."
    rep.InitialFileName = "Word_Test"
    rep.FilterIndex = 2 'format .docm
    If rep.Show = -1 Then
        rep.Execute
    Else
        WordDoc.Close SaveChanges:=False
        Exit Sub
    End If
    WordApp.Quit
End Sub

EDIT 2 : J'ai trouvé la solution, voici le code simplifié pour ceux que ca pourrait aider.

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
Public Sub Macro()
    'Chemins d'accés
    Dim Template As String
    Template = ThisWorkbook.Worksheets("Feuil1").Range("A1")
 
    'Ouverture du fichier Word
    Dim WordApp As Object, WordDoc As Document
    Set WordApp = CreateObject("Word.Application")
    Set WordDoc = WordApp.Documents.Open(Template, ReadOnly:=True)
    WordApp.Visible = True
 
    'Sauvegarde du fichier WordDoc
    Dim rep As FileDialog
    Set rep = WordApp.FileDialog(msoFileDialogSaveAs)
    rep.AllowMultiSelect = False
    rep.Title = "Enregistrer le fichier Word sous..."
    rep.InitialFileName = "Word_Test"
    rep.FilterIndex = 2 'format .docm
    If rep.Show = -1 Then
        rep.Execute
    Else
        WordDoc.Close SaveChanges:=False
    End If
    WordApp.Quit
End Sub