Discussion :

[Jonathan_1988]

Bonjour à tous,
Je me suis lancé dans un projet sur lequel je commence à douter de mes compétences.
C'est pour cette raison que je vous consulte, malgré mes recherches je n'arrive pas à trouver l'aiguille de la botte de paille. J'en profite pour remercier beaucoup d'entre vous qui m'ont aidé à remettre les mains dans le VBA ^^ et à ceux qui souhaiterons bien vouloir m'aider ! d'ici la bonne journée à tous.

Je suis chef de projet dans le nucléaire et mes équipes ont beaucoup de mal à gérer les révisions documentaires ainsi qu'un tas de paramètres qui compose les pages de garde ou le corps du document.
J'ai un fichier excel qui récences tous ces paramètres (Nom de doc, version, status, etc...) que nous appelons Liste des documents à émettre (LDE).

Le but de ma macro est de :
- Créer l'arborescence windows du projet depuis la LDE.
- Créer les documents word à partir d'un template confectionné par mes soins depuis la LDE
- Renseigner les champs (et pas les signets) avec les informations de la LDE

Je bloque sur la lecture de la LDE depuis word.

Je vous demande de l'aide car dans un premier temps j'ai créé les fonctions si dessous qui génère le document à partir de variables enregistrées en dur dans la procédure "main()".
Je souhaite passer à l'étape après afin de pouvoir récupérer les données avec une boucle dans le fichier LDE (*.xlsx).

Ce qu'il me manque :
La procédure afin de lire/ouvrir/modifier le fichier LDE comme si j'étais sous excel depuis Word en VBA pour récupérer les paramètres
L'une des pistes que j'ai trouvé après une recherche approfondie est l'objet :"Application" mais dont j'ai du mal à en comprendre l'utilisation.
Par exemple j'ai déjà une erreur à la définition de la variable xls1 : Dim xls1 As New Excel.Application

Ensuite je pense être en mesure de créer les boucles assez simplement afin de répondre à mon besoin.

Ma macro se compose de de sous procédure
New_Doc () : permet de créer le fichier world depuis un template ".dotx", au bon endroit avec le bon nom
New_structure (): permet de créer l'arborescence du projet sous windows

Voici la procédure "main()"

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
 
Sub Main()
'déclaration des variable
Dim Main_Path_Template As String 'Chemin de la template sur laquelle on se base pour créer les documents
Dim Main_Path_Pjt As String 'Chemin du projet dans le quel les dossiers et word doivent être créé
Dim Main_Doc_Title As String 'titre du document
Dim Main_Doc_Otp As String 'OTP Du document
Dim Main_Doc_Id As String 'ID du document
Dim Main_Doc_Rev As String 'révision du document
Dim Main_Doc_File As String 'Dossier du document
 
'Affectation des variables PUBLIQUE
Main_Path_Template = "C:\Prive_john\Template_word_JJO_A4.dotx"
Main_Path_Pjt = "C:\Prive_john"
Main_Doc_Title = "Plan qualité projet"
Main_Doc_Otp = "99888"
Main_Doc_Id = "3456"
Main_Doc_Rev = "0,0"
Main_Doc_File = "PRO"
 
'Appel des fonctions
New_project_structure Main_Path_Pjt 'Fonction qui créée les diférents dossier de la structure d'un projet à Pub_Path_Pjt
New_doc Main_Path_Template, Main_Path_Pjt, Main_Doc_File, Main_Doc_Otp, Main_Doc_Id, Main_Doc_Title, Main_Doc_Rev
 
End Sub

Voici la fonction new_doc

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
 
Private Sub New_doc(Path_Template As String, Path_Pjt As String, Doc_File As String, Doc_Otp As String, Doc_id As String, Doc_Title As String, Doc_Rev As String)
'*******************************************************************************************
'*Déclaration des variables locale de la sub
    Dim Loc_Path_Template As String 'Chemin du template sur lequel sera créé les documents
    Dim Loc_Path_Pjt ' Chemin du projet
    Dim Loc_Doc_File As String 'Dossier de justification ou définition etc..
    Dim Loc_Doc_Otp 'Numéro d'otp du document
    Dim Loc_Doc_id 'Numéro d'identification du document
    Dim Loc_Doc_Title As String 'Nom du document ainsi que sont extension (Ex: MonDoc)
    Dim loc_Doc_Rev As String 'Revision du document
    Dim Sub_Doc_Id_File As String 'Id du chiffre de dossier pour reconstruction du chemein en fonction de Loc_Doc_File (de 1 à 6)
'*******************************************************************************************
'*Affectation des variables locales avec les arguments de la sub
    Loc_Path_Template = Path_Template
    Loc_Path_Pjt = Path_Pjt
    Loc_Doc_File = Doc_File
    Loc_Doc_Otp = Doc_Otp
    Loc_Doc_id = Doc_id
    Loc_Doc_Title = Doc_Title
    loc_Doc_Rev = Doc_Rev
 
'*************** Calcul de Loc_Doc_File pour coller au chemin du serveur
 
        If Loc_Doc_File = "PRO" Then
            Sub_Doc_Id_File = "1 - PRO"
        ElseIf Loc_Doc_File = "DJD" Then
            Sub_Doc_Id_File = "2 - DJD"
        ElseIf Loc_Doc_File = "DD" Then
            Sub_Doc_Id_File = "3 - DD"
        ElseIf Loc_Doc_File = "DFC" Then
            Sub_Doc_Id_File = "4 - DFC"
        ElseIf Loc_Doc_File = "RCI" Then
            Sub_Doc_Id_File = "5 - RCI"
        ElseIf Loc_Doc_File = "DU" Then
            Sub_Doc_Id_File = "6 - DU"
        Else
            MsgBox "le dossier : ''" & Loc_Doc_File & "'' n'existe pas dans l'arborescence : ''" & Loc_Path_Pjt & "\8 - Docs de sortie\" & "''", vbOKOnly, "Mauvais dossier de document: " & Loc_Doc_File
            GoTo LaFin
        End If
'********************************************************************************************
    'Test si fichier déjà existant pour éviter d'écraser le document sur le serveur
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title & "\" & loc_Doc_Rev & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & "-[" & loc_Doc_Rev & "] - " & Loc_Doc_Title & ".docx", vbDirectory) = Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & "-[" & loc_Doc_Rev & "] - " & Loc_Doc_Title & ".docx" Then
        MsgBox "Le fichier :" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & "-[" & loc_Doc_Rev & "] - " & Loc_Doc_Title & ".docx" & " éxiste déjà", vbOKOnly, "Alerte perte de données"
        GoTo LaFin 'Saut vers fin de sub New_doc pour ne pas écraser le document
    End If
    '* Création du dossier nom de doc et du sous-dossier de la révision
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title, vbDirectory) = "" Then
            MkDir Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title
            If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title & "\" & loc_Doc_Rev, vbDirectory) = "" Then
                MkDir Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title & "\" & loc_Doc_Rev
            End If
        ElseIf Dir(Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title & "\" & loc_Doc_Rev, vbDirectory) = "" Then
            MkDir Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title & "\" & loc_Doc_Rev
    End If
 
    Documents.Add Loc_Path_Template 'Ajoute le document à la collection selon la template
    ActiveDocument.SaveAs FileName:=Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title & "\" & loc_Doc_Rev & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & "-[" & loc_Doc_Rev & "] - " & Loc_Doc_Title & ".docx"
    Documents.Close 'Fermeture du document word
LaFin:
End Sub

Voici la fonction de création des dossiers pour le projet

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
 
'Sub qui créé les dossiers d'un projet si il n'éxiste pas et qui gère la création des dossiers avec le nom du document en fonction de la LDE
Private Sub New_project_structure(Path_Pjt As String)
 
'*Déclaration des variables locale de la sub
Dim Loc_Path_Pjt As String 'Chemin du "\8 - Docs de sortie"
'*Affectation des variables locales avec les arguments de la sub
Loc_Path_Pjt = Path_Pjt
 
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\1 - PRO", vbDirectory) = "" Then
        MkDir Loc_Path_Pjt & "\8 - Docs de sortie\1 - PRO" 'Création dossier
    End If
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\2 - DJD", vbDirectory) = "" Then
        MkDir Loc_Path_Pjt & "\8 - Docs de sortie\2 - DJD" 'Création dossier
    End If
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\3 - DD", vbDirectory) = "" Then
        MkDir Loc_Path_Pjt & "\8 - Docs de sortie\3 - DD" 'Création dossier
    End If
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\4 - DFC", vbDirectory) = "" Then
        MkDir Loc_Path_Pjt & "\8 - Docs de sortie\4 - DFC" 'Création dossier
    End If
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\5 - RCI", vbDirectory) = "" Then
        MkDir Loc_Path_Pjt & "\8 - Docs de sortie\5 - RCI" 'Création dossier
    End If
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\6 - DU", vbDirectory) = "" Then
        MkDir Loc_Path_Pjt & "\8 - Docs de sortie\6 - DU" 'Création dossier
    End If
 
End Sub

[Jonathan_1988]

Bonjour à tous,

Il faut donc dans un premier temps déclarer la library Excel

Code :

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

1
2
3
4
5
6
7
8
9
10
 
 'Microsoft Excel 16.0 Object Library
Dim xlApp As Excel.Application, xlWbk As Excel.Workbook, xlWsh As Excel.Worksheet
 
Set xlApp = New Excel.Application
xlApp.Visible = True
If xlWbk Is Nothing Then
    Set xlWbk = xlApp.Workbooks.Open(Loc_Path_Pjt & "\8 - Docs de sortie\" & Main_Doc_Otp & "-0000")
End If
Set xlWsh = xlWbk.Worksheets(strSheetName)

[Philippe Tulliez]

Bonjour,

Il faut donc dans un premier temps déclarer la library Excel

Effectivement l'une des pistes est de référencer la bibliothèque Microsoft Excel xx.x Object Library. Cependant si l'application doit tourner sur des versions différentes, il est préférable de travailler en Late Binding
Si le sujet vous intéresse, je vous invite à lire mon billet VBA Excel - La compilation conditionnelle ou comment développer en EarlyBinding et distribuer en late binding

Pour le reste

Le but de ma macro est de :
- Créer l'arborescence windows du projet depuis la LDE.
- Créer les documents word à partir d'un template confectionné par mes soins depuis la LDE
- Renseigner les champs (et pas les signets) avec les informations de la LDE

La LDE, présente dans Excel, est-elle construite dynamiquement ou manuellement.
Avez-vous déjà réalisé l'arborescence de la LDE ?
Quel type de champs souhaitez-vous lister ?

[Jonathan_1988]

Bonjour Philippe et merci énormément pour avoir pris le temps de regarder ce sujet.
Je viens ce matin de construire le fichier LDE en question.

La LDE, présente dans Excel, est-elle construite dynamiquement ou manuellement.

Cet Excel est construit au fur et à mesure du projet de manière manuel. J'ai pour projet d'automatiser la création d'un nouveau document par formulaire mais ce développement sera dans un second temps.
Dans ma société il contient aussi l'historique des envois et les retours du client. Ce fichier gère vraiment toute l'interface documentaire et est centrale pour nous. Je cherche à gérer de manière automatique toutes les gestions documentaires tout au long du projet qui peut contenir plusieurs centaines de documents.

Avez-vous déjà réalisé l'arborescence de la LDE ?

Si vous parlez de la structure du document, oui il est réalisé mais afin de répondre aux différents clients, je vais essayer de le rendre malléable.
J'ai déposé le fichier Excel en pièce jointe.

Quel type de champs souhaitez-vous lister ?

Le titre du document
Le numéro d'otp (qui est une référence du projet dans ma société)
Le ID (incrémentale numérique qui permet d'identifier et de créer un numéro unique "clé primaire de tri")
La révision
Le status

Et plein d'autre car le but final est de construire un tableau de suivis de révision automatique.

Effectivement l'une des pistes est de référencer la bibliothèque Microsoft Excel xx.x Object Library. Cependant si l'application doit tourner sur des versions différentes, il est préférable de travailler en Late Binding
Si le sujet vous intéresse, je vous invite à lire mon billet VBA Excel - La compilation conditionnelle ou comment développer en EarlyBinding et distribuer en late binding

Pour le reste

J'ai beaucoup de mal avec cette notion car ma formation initiale est tournée industriel (API) et très peu "Objet".... D'où mes compétences limitées dans ce domaine. Cependant je vais me plonger dans votre lien afin d'y appréhender les contours.

Encore une fois mille merci de votre réponse

Après lecture :
Early-binding permet de créer des sortes d'alias pouvant être utilisés dans le reste de la procédure mais qui ont besoin de la library s'ils font appel à un autre soft office différent.
On utilise donc le late-Binding afin de passer en référence les objet Word et Excel Afin que tout le code soit exécutable depuis n'importe quelle plateforme si j'ai bien suivi ?

Si je fais le code suivant :

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
 
'*Déclaration des variables PUBLIQUES
Option Explicit
#Const IsLateBinding = True
 
Sub Main()
 ' Compilation conditionnelle
  #If IsLateBinding Then
      Dim AppXl As Object
      Dim AppWd As Object
      Set AppXl = GetObject("Excel.Application")
      Set AppWd = GetObject("Word.Application")
   #Else
      ' Nécessite le référencement de Microsoft Word 16.0 Object Library
      Dim AppXl As Excel.Application
      Dim AppWd As Word.pplication
      MsgBox "Phase de test EarlyBinding"
  #End If
 
End Sub

Je ne fais pas de early-Binding mais je vais pouvoir utiliser toutes les bibliothèques de Word et Excel dans les procédures et sous procédure appelé par Main() ?
Exemple :
AppWd.documents.add "Chemin du document"
ou
AppXl.workbook.worksheet.Range("E526").Select

Philippe pouvez-vous confirmer ?

Cordialement

[Philippe Tulliez]

Bonjour Jonathan,
Lorsque l'on utilise une autre application que celle où l'on développe (ici Excel dans une application Word) et que l'on référence la bibliothèque Excel, on fait du Early Binding.
Avantage : On bénéficie de l'intellisense (aide à la saisie semi-automatique de code) et on peut également utiliser les constantes propre à l'application (les préfixées xl pour Excel) comme xlCenter, xlTop
Désavantage : Si je développe dans une version supérieure à celle où l'application va tourner, il y aura un message "référence manquante" dans la version antérieure.
C'est la raison pour laquelle pour éviter les problèmes, je développe en early binding et je livre l'application en Late binding mais si c'est pour un usage interne où il n'y a aucun risque d'avoir des versions différentes, on peut rester en early binding

[Philippe Tulliez]

Bonjour Jonathan,
En examinant le classeur que vous avez joint à la discussion, je vois que vous utilisez les tableaux structurés (ListObject en VBA) ce qui est parfait pour lire les données. En effet grâce à cela on ne doit pas savoir dans quelle feuille se trouve la table

Pour en savoir plus sur la manipulation en VBA des tableaux structurés (ListObject), je vous conseille la lecture de ce tutoriel de Pierre Fauconnier titré Excel: Les tables de données en VBA

Je vous ai mis un petit exemple ci-dessous qui vous aidera à comprendre comment utiliser un ListObject depuis Word

J'ai placé le document Word contenant le code VBA dans un répertoire quelconque et votre classeur Excel 99888-PRO-0000 - LDE.xlsx dans un sous-répertoire nommé LDE
Dans la feuille LDE, j'ai renommé le tableau structuré t_Lde au lieu de Tableau5 afin d'avoir un nom plus explicite

Pour l'exemple, j'ouvre le classeur depuis Word et j'ouvre un UserForm (UserForm1) contenant un ListBox (ListBox1) après avoir alimenté celui-ci avec les données de la table.
En fermant le formulaire j'affiche un MsgBox pour fermer ou pas le classeur et quitter l'application Excel

Le UserForm ne contient qu'un ListBox et aucun code VBA

Je suis plus à l'aise de manipuler les applications Word, Power Point, etc. depuis Excel ou Access que depuis Word donc il est sans doute possible de faire mieux
J'ai eu 1 x ou deux un bug sur la ligne 17 dans Main (Set xlTable = Excel.Range(TableName).ListObject) en relançant, je n'ai plus eu de souci (il faut savoir que Range est également utilisé dans Word mais n'est pas le même objet (raison pour laquelle j'ai fait précéder Excel. Je n'ai pas cherché plus loin la raison du bug.

Code de la procédure Main

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
Sub Main()
  ' Déclaration et affectation des variables
  Const SubFolder As String = "\LDE\"                        ' Sous répertoire où se trouve le classeur
  Const WorkbookName As String = "99888-PRO-0000 - LDE.xlsx" ' Nom du classeur LDE
  Const TableName As String = "t_Lde"                        ' Nom de la table
  Dim xlApp As Excel.Application
  Dim xlWbk As Excel.Workbook
  Dim xlTable As ListObject
  Dim CurrentPath As String
  Dim FullName As String
  Set xlApp = New Excel.Application
  xlApp.Visible = True
  CurrentPath = ThisDocument.Path                      ' Répertoire courant de ThisDocument
  FullName = CurrentPath & SubFolder & WorkbookName    ' Nom complet du classeur
  Set xlWbk = xlApp.Workbooks.Open(FileName:=FullName) ' Ouvrir le classeur
  Word.Application.Activate                            ' Mettre l'application Word en avant plan
  Set xlTable = Excel.Range(TableName).ListObject      ' Affecter le ListObject
  ' Charge les données dans le ListBox du formulaire
  With UserForm1
   LoadUserForm .ListBox1, xlTable
  .Show
  End With
  ' Fin
  If MsgBox("Quittez l'application Excel", vbYesNo + vbDefaultButton2 + vbInformation) = vbYes Then
     xlWbk.Close
     xlApp.Quit
     Set xlApp = Nothing: Set xlWbk = Nothing: Set xlTable = Nothing
  End If
End Sub

Code de la procédure nommée LoadUserForm qui charge la liste du ListBox

Code :

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

1
2
3
4
5
6
7
8
Sub LoadUserForm(oListBox As MSForms.ListBox, oTable As ListObject)
  Dim r As Excel.Range
  Set r = oTable.DataBodyRange
  With oListBox
  .List = r.Value ' Données de la table
  .ColumnCount = r.Columns.Count
  End With
End Sub

Illustration

[Jonathan_1988]

Non de dieu !!!

Je digère tout cela, comment exploité les tableaux structurés etc... et je vous recontact dès que j'ai avancé pour porter le code en multiversion.
Merci énormément pour votre aide la tâche s'annonce ardu et vos exemples vont beaucoup m'aider !

Très cordialement

Jonathan

[Jonathan_1988]

Bonjour,

Je vous donne les avancées de mon travail qui a bien évoluer et où je suis arrivé a une version satisfaisante à débuguer.

Il reste les points suivant à faire :
- Gérer l'ajout d'un document une fois que la macro a tournée pour la première fois et que l'arborescence est faite
- Création d'un fichier logs qui enregistre les actions de la macro tel que :
- Dossier déjà existant
- Nouveau documents
- Etc...
- Création d'un fichier excel avec les paramètres spécifiques à chaque document
- Formulaire word afin de renseigner les variables Main_Path_Template, Main_Path_Otp, Main_Doc_Otp
- Coder la partie pour mettre à jour tous les champs et les entête etc... sur le document actif en cours de création
- Rendre le code adaptatif à tout version (tant que faire ce epu) Late-binding
- Bug très chiant de document qui ne se ferme pas ou reste ouvert en caché. <==== IMPORTANT !!!

Je vous envoie le code complet : (Les document de travaux sont en PJ attention docx au lieu de dotx)

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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
'*Déclaration des variables PUBLIQUES
Option Explicit
#Const IsLateBinding = True
 
Sub Main()
'déclaration des variable Main
Dim Main_Path_Template As String 'Chemin de la template sur laquelle on se base pour créer les documents
Dim Main_Path_Pjt As String      'Chemin du projet dans le quel les dossiers et word doivent être créé
Dim Main_Doc_Title As String     'titre du document
Dim Main_Doc_Otp As String       'OTP Du document
Dim Main_Doc_Id As String        'ID du document
Dim Main_Doc_Rev As String       'révision du document
Dim Main_Doc_File As String      'Dossier du document
Dim Main_Doc_Status As String    'Status du document
Dim Main_Pjt_Name As String       'Nom du pojet
Dim Main_Client As String        'Nom du client
Dim Main_Client_Number As String 'Numéro GERAL du client
Dim Main_Num_Docs As Integer     'Nombre de document présent dans xl_t_LDE
Dim Main_Counter As Integer      'Compteur pour la boucle
 
'Affectation des variables Main A faire dans un formulaire sous word !!!
Main_Path_Template = "C:\Prive_john\FR_GERAL_A4.dotx"
Main_Path_Pjt = "C:\Prive_john"
Main_Doc_Otp = "99888"
 
New_project_structure Main_Path_Pjt 'Fonction qui créée les diférents dossiers de la structure d'un projet à Main_Path_Pjt
 
'Déclaration des objets Excel et de listObject
Dim xlApp As Excel.Application                                'Objet Excel
Dim xlWbk As Excel.Workbook                                   'Objet fichier excel
Dim xlTable_LDE As ListObject                                 'Objet Tableau structuré où sont enregistré les données relatives aux documents
Dim xlTable_Var_Pjt As ListObject                             'Objet tableau structuré où sont enregistré les données du projet dans l'EXCEL LDE
Set xlApp = New Excel.Application                             'Nouvelle instance excel
xlApp.Visible = False                                         'Je cache la feuille Excel pendant l'exécution
Set xlWbk = xlApp.Workbooks.Open(FileName:=Main_Path_Pjt & "\8 - Docs de sortie\" & Main_Doc_Otp & "-PRO-0000 - LDE.xlsx") 'Ouvrir le classeur
Set xlTable_LDE = Excel.Range("xl_t_LDE").ListObject          'Affecter le ListObject tableau structuré du fichier excel LDE (permet de se passer de la sheets excel)
Set xlTable_Var_Pjt = Excel.Range("xl_t_Var_Pjt").ListObject  'Affecter le ListObject tableau structuré du fichier excel LDE (permet de se passer de la sheets excel)
Main_Num_Docs = xlTable_LDE.ListRows.Count                    'Comptage du nombre de documents dans le tableau strucuré xl_t_LDE
For Main_Counter = 2 To Main_Num_Docs + 1                     '(+1 = Ofset) Déclaration de la boucle permettant de créer l'arborescence windows ainsi que le word selon la template et l'affectation des champs (Fields)
                                                              ' Ligne 1 = Entête, Ligne 2 = Premier document /!\ Premier doc = LDE
    Main_Doc_Title = xlTable_LDE.Range.Cells(Main_Counter, xlTable_LDE.ListColumns("Doc_Title").Index).Value2          'Lecture de la cell à l'index "Counter" et à la colonne de nom "Doc_Title"
    Main_Doc_Id = xlTable_LDE.Range.Cells(Main_Counter, xlTable_LDE.ListColumns("Doc_ID").Index).Value2                'Lecture de la cell à l'index "Counter" et à la colonne de nom "Doc_ID"
    Main_Doc_Rev = xlTable_LDE.Range.Cells(Main_Counter, xlTable_LDE.ListColumns("Doc_Rev").Index).Value2              'Lecture de la cell à l'index "Counter" et à la colonne de nom "Doc_Rev"
    Main_Doc_File = xlTable_LDE.Range.Cells(Main_Counter, xlTable_LDE.ListColumns("Doc_File").Index).Value2            'Lecture de la cell à l'index "Counter" et à la colonne de nom "Doc_File"
    Main_Doc_Status = xlTable_LDE.Range.Cells(Main_Counter, xlTable_LDE.ListColumns("Doc_Status").Index).Value2        'Lecture de la cell à l'index "Counter" et à la colonne de nom "Doc_Status"
    Main_Client_Number = xlTable_Var_Pjt.Range.Cells(2, xlTable_Var_Pjt.ListColumns("Client_Number").Index).Value2 'récupération de la valeur num client
    Main_Pjt_Name = xlTable_Var_Pjt.Range.Cells(2, xlTable_Var_Pjt.ListColumns("Pjt_name").Index).Value2       'récupération de la valeur de nom du prjet
    Main_Client = xlTable_Var_Pjt.Range.Cells(2, xlTable_Var_Pjt.ListColumns("Client").Index).Value2        'récupération de la valeur du nom du client
    New_doc Main_Path_Template, Main_Path_Pjt, Main_Doc_File, Main_Doc_Otp, Main_Doc_Id, Main_Doc_Title, Main_Doc_Rev, Main_Doc_Status, Main_Client_Number, Main_Pjt_Name, Main_Client  ' Création du document word selon la template et les paramètres calculé dans la boucle for
Next Main_Counter
xlWbk.Close 'Libère le fichier Excel
xlApp.Quit 'Ferme Excel
End Sub
 
Private Sub New_doc(Path_Template As String, Path_Pjt As String, Doc_File As String, Doc_Otp As String, Doc_id As String, Doc_Title As String, Doc_Rev As String, Doc_Status As String, Client_number As String, Pjt_Name As String, client As String)
'*******************************************************************************************
'*Déclaration des variables locale de la sub
    Dim Loc_Path_Template As String 'Chemin du template sur lequel sera créé les documents
    Dim Loc_Path_Pjt                'Chemin du projet
    Dim Loc_Doc_File As String      'Dossier de justification ou définition etc..
    Dim Loc_Doc_Otp                 'Numéro d'otp du document
    Dim Loc_Doc_id                  'Numéro d'identification du document
    Dim Loc_Doc_Title As String     'Nom du document ainsi que sont extension (Ex: MonDoc)
    Dim loc_Doc_Rev As String       'Revision du document
    Dim Loc_Doc_Status As String    'Status du document
    Dim Loc_Client_Number As String 'Numéo de client GERAL
    Dim Loc_Client As String        'Nom du client
    Dim Loc_Pjt_Name As String      'Nom du projet
    Dim Sub_Doc_Id_File As String   'Id du chiffre de dossier pour reconstruction du chemein en fonction de Loc_Doc_File (de 1 à 6)
 
'*******************************************************************************************
'*Affectation des variables locales avec les arguments de la sub
    Loc_Path_Template = Path_Template
    Loc_Path_Pjt = Path_Pjt
    Loc_Doc_File = Doc_File
    Loc_Doc_Otp = Doc_Otp
    Loc_Doc_id = Doc_id
    Loc_Doc_Title = Doc_Title
    loc_Doc_Rev = Doc_Rev
    Loc_Doc_Status = Doc_Status
    Loc_Client_Number = Client_number
    Loc_Pjt_Name = Pjt_Name
    Loc_Client = client
 
'*************** Calcul de Loc_Doc_File pour coller au chemin du serveur
 
        If Loc_Doc_File = "PRO" Then
            Sub_Doc_Id_File = "1 - PRO"
        ElseIf Loc_Doc_File = "DJD" Then
            Sub_Doc_Id_File = "2 - DJD"
        ElseIf Loc_Doc_File = "DD" Then
            Sub_Doc_Id_File = "3 - DD"
        ElseIf Loc_Doc_File = "DFC" Then
            Sub_Doc_Id_File = "4 - DFC"
        ElseIf Loc_Doc_File = "RCI" Then
            Sub_Doc_Id_File = "5 - RCI"
        ElseIf Loc_Doc_File = "DU" Then
            Sub_Doc_Id_File = "6 - DU"
        Else
            MsgBox "le dossier : ''" & Loc_Doc_File & "'' n'existe pas dans l'arborescence : ''" & Loc_Path_Pjt & "\8 - Docs de sortie\" & "''", vbOKOnly, "Mauvais dossier de document: " & Loc_Doc_File
            GoTo LaFin
        End If
'********************************************************************************************
    'Test si fichier déjà existant pour éviter d'écraser le document sur le serveur
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title & "\" & loc_Doc_Rev & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & "-[" & loc_Doc_Rev & "] - " & Loc_Doc_Title & ".docx", vbDirectory) = Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & "-[" & loc_Doc_Rev & "] - " & Loc_Doc_Title & ".docx" Then
        MsgBox "Le fichier :" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & "-[" & loc_Doc_Rev & "] - " & Loc_Doc_Title & ".docx" & " éxiste déjà", vbOKOnly, "Alerte perte de données"
        GoTo LaFin 'Saut vers fin de sub New_doc pour ne pas écraser le document
    End If
 
    '* Création du dossier nom de doc et du sous-dossier de la révision
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title, vbDirectory) = "" Then
            MkDir Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title
            If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title & "\" & loc_Doc_Rev, vbDirectory) = "" Then
                MkDir Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title & "\" & loc_Doc_Rev
            End If
        ElseIf Dir(Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title & "\" & loc_Doc_Rev, vbDirectory) = "" Then
            MkDir Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title & "\" & loc_Doc_Rev
    End If
 
 
    'Affectation des valeurs du documents dans les "Fields" qui sont les champs custom décrlaré dans le document word dans la partie Information
    Documents.Add Loc_Path_Template 'Ajoute le document à la collection selon la template
    ActiveDocument.CustomDocumentProperties("_Doc_ID").Value = Loc_Doc_id
    ActiveDocument.CustomDocumentProperties("_Doc_File").Value = Loc_Doc_File
    ActiveDocument.CustomDocumentProperties("_Doc_Status").Value = Loc_Doc_Status
    ActiveDocument.CustomDocumentProperties("_Doc_Title").Value = Loc_Doc_Title
    ActiveDocument.CustomDocumentProperties("_Doc_Rev").Value = loc_Doc_Rev
    ActiveDocument.CustomDocumentProperties("_Pjt_Name").Value = Loc_Pjt_Name
    ActiveDocument.CustomDocumentProperties("_Client_Number").Value = Loc_Client_Number
    ActiveDocument.CustomDocumentProperties("_Client").Value = Loc_Client
    'Mise à jour des Fields,  du body, et des en-têtes/pied de page
    Dim Sub_Doc_Sections As Sections
    Dim Sub_Doc_Headers_footers As HeaderFooter
 
    'Code pour mettre à jour les fields en-têtes et pieds de page et body à FAIRE
 
    ActiveDocument.SaveAs FileName:=Loc_Path_Pjt & "\8 - Docs de sortie\" & Sub_Doc_Id_File & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & " - " & Loc_Doc_Title & "\" & loc_Doc_Rev & "\" & Loc_Doc_Otp & "-" & Loc_Doc_File & "-" & Loc_Doc_id & "-[" & loc_Doc_Rev & "] - " & Loc_Doc_Title & ".docx"
    Documents.Close 'Fermeture du document word
 
LaFin:
End Sub
'Sub qui créé les dossiers d'un projet si il n'éxiste pas et qui gère la création des dossiers avec le nom du document en fonction de la LDE
Private Sub New_project_structure(Path_Pjt As String)
 
'*Déclaration des variables locale de la sub
Dim Loc_Path_Pjt As String 'Chemin du "\8 - Docs de sortie"
'*Affectation des variables locales avec les arguments de la sub
Loc_Path_Pjt = Path_Pjt
 
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\1 - PRO", vbDirectory) = "" Then
        MkDir Loc_Path_Pjt & "\8 - Docs de sortie\1 - PRO" 'Création dossier
    End If
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\2 - DJD", vbDirectory) = "" Then
        MkDir Loc_Path_Pjt & "\8 - Docs de sortie\2 - DJD" 'Création dossier
    End If
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\3 - DD", vbDirectory) = "" Then
        MkDir Loc_Path_Pjt & "\8 - Docs de sortie\3 - DD" 'Création dossier
    End If
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\4 - DFC", vbDirectory) = "" Then
        MkDir Loc_Path_Pjt & "\8 - Docs de sortie\4 - DFC" 'Création dossier
    End If
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\5 - RCI", vbDirectory) = "" Then
        MkDir Loc_Path_Pjt & "\8 - Docs de sortie\5 - RCI" 'Création dossier
    End If
    If Dir(Loc_Path_Pjt & "\8 - Docs de sortie\6 - DU", vbDirectory) = "" Then
        MkDir Loc_Path_Pjt & "\8 - Docs de sortie\6 - DU" 'Création dossier
    End If
 
End Sub

Encore une fois merci beaucoup