XL 2016 générer un doc word par client

'Déclaration des différentes variables
Dim appWord As Object
Dim docWord As Object
Dim Fichier As String
Dim chemin As String
Dim DossierRESUME As String
Dim DateJour As String
Dim FI As String
Dim Date as String
Dim NomClient as string
Dim numero as integer
Numero=1
On Error Resume Next

While numero = 1
Cells (numéro,2)= numero
'Création du libelle du fichier word
Date=
NomClient = «
FI = "LETTRE DE MISSION" & "_" & NomClient " & "_" & Date

'Enregistre le rapport word dans le dossier dans lequel le fichier excel est présent
DossierRESUME = ThisWorkbook.Path
'Vérifie si le répertoire existe
If Dir(DossierRESUME, vbDirectory + vbHidden) <> "" Then
'Vérifie que le dossier à créer n'existe pas déjà dans le répertoire
If Dir(DossierRESUME & "\" & FI, vbDirectory + vbHidden) = "" Then
MkDir DossierRESUME & "\" & FI
Else
MsgBox ("le dossier existe déjà")
End If
End If


'Ouverture du Resumé de l'activité
Set appWord = CreateObject("Word.application") 'Ouvre session Word
appWord.Visible = True
chemin = ThisWorkbook.Path 'Permet variabilité emplacement dossier
Set docWord = appWord.Documents.Open(chemin & "\" & "Mod006_Rapport de Mission_Alpha Phi – SCPI.docx", ReadOnly:=False) 'Ouvre document Word TEST
docWord.SaveAs DossierRESUME & "\" & FI
docWord.Close 'Ferme le document WORD TEST
Set appWord = CreateObject("Word.application") 'Ouvre session Word
appWord.Visible = True
chemin = ThisWorkbook.Path 'Permet variabilité emplacement dossier
Set docWord = appWord.Documents.Open(chemin & "\" & FI & ".docx", ReadOnly:=False)




ActiveWorkbook.SaveCopyAs DossierRESUME & "\" & FI & ".docx"

Application.CutCopyMode = False

End Sub
Wend

Cliquez pour agrandir...