Sub Bouton29_QuandClic()
ChDir "Y:\TKAF\R04\A422\_Commun-Agence\Evelyne-carine\Dossier Mod Aff. en cours\"
Dim MonRep As String
MonRep = "Y:\TKAF\R04\A422\_Commun-Agence\Evelyne-carine\Dossier Mod Aff. en cours\" & Cells(11, 3).Value & " - " & Cells(7, 3).Value
MkDir (MonRep)
' !!!!!!!!!!!!!!!!!!!!!!!EXEMPLE PUBLIPOSTAGE !!!!!!!!!!!!!!!!!!!!!!!!!!
Dim apWord, docWord, curCell As Range, chemin
chemin = "Y:\TKAF\R04\A422\_Commun-Agence\Evelyne-carine\Dossier MOD\ISO + Doc type\"
'créer une application Word
Set apWord = CreateObject("word.application")
'curCell = première entrée (C11)
Set curCell = ThisWorkbook.Sheets("Feuil1").Range("C11")
'tant que quelque chose est écrit dans curCell
While curCell.Value <> vbNullString
'créer un nouveau document à partir du modèle "modele\invitation.dot"
'PS: - le fichier "invitation.dot" est créé avec des Signets (appelés plus tard dans la macro)
' ils renvoient à un emplacement ou une sélection de texte
' dans cet exemple, ils renvoient aux diférents textes entre <>
' - pour créer un signet dans word, Insertion --> Signet
Set docWord = apWord.Documents.Add(Template:=chemin & "modele lettre FT.dot")
'aller au signet "date" dans le doc Word
apWord.Selection.Goto What:=-1, Name:="DateJour"
'y écrire la date d'aujourd'hui formatée
apWord.Selection.TypeText Format(Now, "dd/mm/yyyy")
'aller au signet "NomChantier" dans le doc Word
apWord.Selection.Goto What:=-1, Name:="NomChantier"
'y écrire la valeur de C11
apWord.Selection.TypeText ThisWorkbook.Sheets("Feuil1").Range("C11").Value
apWord.Selection.Goto What:=-1, Name:="NomClient"
apWord.Selection.TypeText ThisWorkbook.Sheets("Feuil1").Range("C15").Value
apWord.Selection.Goto What:=-1, Name:="AdresseClient"
apWord.Selection.TypeText ThisWorkbook.Sheets("Feuil1").Range("C17").Value
'sauver le fichier Word (en lui donnant le nom souhaité
apWord.ChangeFileOpenDirectory (MonRep)
apWord.SaveAs Filename:="Plannification +Dde ligne EDF - " & curCell.Value & ".doc" <-- ERREUR ICI
'fermet le document Word
docWord.Close
'décaler curCell d'une cellule vers le bas
Set curCell = curCell.Offset(1, 0)
Wend
'fermer l'application Word
apWord.Quit
'détruire les objets
Set apWord = Nothing: Set docWord = Nothing: Set curCell = Nothing
Windows.Application.Quit
End Sub