Génération de multiples documents word à partir d'un fichier Excel

1 pièce(s) jointe(s)

Bonjour à tous,

J'ai besoin d'un petit coup de pouce car je n'arrive pas à créer plusieurs documents Word à partir d'une source de données Excel.
Ma macro a pour but de chercher si la valeur ALLEMAGNE ou AUTRICHE se trouve dans la colonne A de mon fichier Excel.
Si c'est le cas alors il crée des tcd, crée des documents word, effectue un publipostage, enregistre les documents et les ferme.
La 1ere condition fonctionne mais c'est quand je passe à la 2e que ma macro plante et me met un message d'erreur d’exécution 462: le serveur distant n'existe pas ou n'est pas disponible:

Pièce jointe 150908

Je ne sais pas pourquoi il me met ce message car le chemin existe et il n'y a pas de fichier portant le même nom.
J'aimerai répliquer cette macro pour créer autant de documents word que j'ai de valeurs (en dur) dans ma colonne A

Le code est ci-dessous:

Code:

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
88
89
Sub atest()
Workbooks.Open ThisWorkbook.Path & "\MEMO.xls"
Windows("MEMO.xls").Activate
 
Dim rng As Range
Dim rngFound_ALLEMAGNE As Range
Dim rngFound_AUTRICHE As Range
 
Set rng = Columns("A")
Set rngFound_ALLEMAGNE = rng.Find("ALLEMAGNE")
Set rngFound_AUTRICHE = rng.Find("AUTRICHE")
 
If rngFound_ALLEMAGNE Is Nothing Then
Else:
Application.Run "KOPER.xlsm!tcd_Packing_list_ALLEMAGNE"
Application.Run "KOPER.xlsm!tcd_Packing_list_ALLEMAGNE_BIS"
Application.Run "KOPER.xlsm!tcd_Courrier_Oyak_ALLEMAGNE"
Application.Run "KOPER.xlsm!tcd_atr_ALLEMAGNE"
 
    'Workbooks("MEMO.xls").Save
    ActiveWindow.WindowState = xlMinimized
 
' PUBLIPOSTAGE_DOCUMENTS KOPER
 
    Dim WordApp As Object
    Dim WordDoc As Object
    Set WordApp = CreateObject("Word.Application")     '-- ouvre une session Word
    WordApp.Visible = True
 
    Set WordDoc = WordApp.Documents.Add    '-- crée un nouveau document
    WordApp.Run MacroName:="Publipostage_packing_list_allemagne"
    ActiveDocument.SaveAs2 "C:\OYAK\KOPER\ALMANYA FR.docx"
    ActiveDocument.Close
    WordDoc.Close savechanges:=False
    Set WordDoc = Nothing
 
    Set WordDoc = WordApp.Documents.Add
    WordApp.Run MacroName:="Publipostage_packing_list_ALLEMAGNE_BIS"
    ActiveDocument.SaveAs2 "C:\OYAK\KOPER\ALMANYA.docx"
    ActiveDocument.Close
    WordDoc.Close savechanges:=False
    Set WordDoc = Nothing
 
    Set WordDoc = WordApp.Documents.Add
    WordApp.Run MacroName:="Publipostage_courrier_oyak_ALLEMAGNE_v2"
    ActiveDocument.SaveAs2 "C:\OYAK\KOPER\ALMANYA2.docx"
    ActiveDocument.Close
    WordDoc.Close savechanges:=False
    Set WordDoc = Nothing
 
    Set WordDoc = WordApp.Documents.Add
    WordApp.Run MacroName:="publipostage_atr_ALLEMAGNE"
    ActiveDocument.SaveAs2 "C:\OYAK\KOPER\ATR ALLEMAGNE.docx"
    ActiveDocument.Close
    WordDoc.Close savechanges:=False
    Set WordDoc = Nothing
End If
Set WordDoc = Nothing
WordApp.Quit savechanges:=wdDoNotSaveChanges
Set WordApp = Nothing
 
Windows("MEMO.xls").Activate
 
If rngFound_AUTRICHE Is Nothing Then
Else:
Application.Run "KOPER.xlsm!tcd_Packing_list_AUTRICHE_BIS"
 
  'Workbooks("MEMO.xls").Close SaveChanges:=True
 
' PUBLIPOSTAGE_DOCUMENTS KOPER
    Set WordApp = CreateObject("Word.Application")     '-- ouvre une session Word
    WordApp.Visible = True
    Set WordDoc = WordApp.Documents.Add    '-- crée un nouveau document
    WordApp.Run MacroName:="Publipostage_packing_list_AUTRICHE_BIS"
    ActiveDocument.SaveAs2 "C:\OYAK\KOPER\AVUSTURYA.docx"
    ActiveDocument.Close
    WordDoc.Close savechanges:=False
 
End If
Set WordDoc = Nothing
WordApp.Quit savechanges:=wdDoNotSaveChanges
 
Set rng = Nothing
Set rngFound_ALLEMAGNE = Nothing
Set rngFound_AUTRICHE = Nothing
Set WordApp = Nothing
 
 
End Sub

Merci d'avance de votre aide !

Bonjour, bonjour !
Solution simple : dans le code, positionner le curseur texte sur le premier mot de la ligne puis appuyer sur la touche :f1: ‼

Conclusion ?

__________________________________________________________________________________________
Copier / Coller n'est pas programmer !

Effectivement il manquait des propriétés sur mon expression SaveAs2

Code:

1
2
3
4
5
WordApp.ActiveDocument.SaveAs2 Filename:="C:\OYAK\KOPER\ATR AUTRICHE.docx", FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, CompatibilityMode:=15

est plus correct
Merci pour votre aide