Bonjour à tous,
Une solution consiste à faire le mailing directement depuis un tableau structuré Excel.
Le code ci-dessous crée un fichier Word à partir d'un modèle (peu importe le format : docm, docx). Ici le modèle est dans le répertoire de destination par simplicité mais il pourrait être dans les modèles Word.
Comme indiqué en commentaire dans le code, il vaut mieux référencer Word dans en phase de développement.
Visiblement les paramètres du type WdXXX semblent fonctionner même en late binding.
Option Explicit
' En phase de développement, référencer la DLL Microsoft Word pour profiter de l'intellisence
' Un point derrière la variable objet vous donne accès à toutes ses propriétés, actions, événements.
Sub MettreAJourLesSignets()
Dim I As Integer
Dim AireNom As Range, AireAdresse As Range, AireCP As Range, AireCommune As Range, AireObjet As Range, AireMontant As Range
Dim RepertoireDeDestination As String
' En phase de développement, référencer la DLL Microsoft Word pour profiter de l'intellisence
'Dim WordApp As Word.Application
'Dim WordDoc As Word.Document, DocEnCours As Word.Document
' Pour distribuer le fichier sur des postes avec des versions pouvant être différentes passer en late binding
Dim WordApp As Object
Dim WordDoc As Object
RepertoireDeDestination = "D:\Documents\XXXXXX\" ' A adapter
Set AireNom = Range("t_Docs[Nom]")
Set AireAdresse = Range("t_Docs[Adresse]")
Set AireCP = Range("t_Docs[Code postal]")
Set AireCommune = Range("t_Docs[Commune]")
Set AireObjet = Range("t_Docs[Objet]")
Set AireMontant = Range("t_Docs[Montant]")
Set WordApp = CreateObject("word.application") 'Ouvre une session Word
WordApp.Visible = True 'False word masqué pendant l'operation
For I = 1 To AireNom.Count
CreerUnNouveauFichierAPartirDUnModele WordApp, RepertoireDeDestination & "Modèle mailing.docm" ' A adapter
Set WordDoc = WordApp.ActiveDocument
MajSignet WordDoc, "Nom", AireNom(I)
MajSignet WordDoc, "Adresse", AireAdresse(I)
MajSignet WordDoc, "Code_Postal", AireCP(I)
MajSignet WordDoc, "Commune", AireCommune(I)
MajSignet WordDoc, "Objet", AireObjet(I)
MajSignet WordDoc, "Montant", Format(AireMontant(I), "#,##0.00 €")
With WordDoc
.SaveAs2 RepertoireDeDestination & AireNom(I) & " " & Year(Date) & "-" & Month(Date) & "-" & Day(Date)
.Close savechanges:=True
End With
Set WordDoc = Nothing
Next I
WordApp.Quit 'ferme la session Word
Set WordDoc = Nothing
Set WordApp = Nothing
Set AireNom = Nothing: Set AireAdresse = Nothing: Set AireCP = Nothing
Set AireCommune = Nothing: Set AireObjet = Nothing: Set AireMontant = Nothing
End Sub
Sub MajSignet(ByVal DocEnCours As Object, ByVal NomDuSignet As String, ByVal ContenuDuSignet As Variant)
DocEnCours.Bookmarks(NomDuSignet).Select
With DocEnCours.Parent.Selection
.Range.Text = ContenuDuSignet
.Expand Unit:=3 'wdSentence ' 3 : Si problème en late binding, prendre la valeur numérique correspondante dans la fenêtre propriétés
.Bookmarks.Add Name:=NomDuSignet ' Pour reconstituer le signet
End With
End Sub
Sub CreerUnNouveauFichierAPartirDUnModele(ByVal WordApp2 As Word.Application, ByVal CheminEtNomDocumentModele As String)
WordApp2.Documents.Add Template:=CheminEtNomDocumentModele, NewTemplate:=False, DocumentType:=0
End Sub