Sub Publipostage()
'===============
'PRÉPARATION
'===============
'Par sous-programme, on donne d'abord un nom bien ajusté aux cellules remplies pour que le publipostage ne soit pas ralenti pour rien :
SP_Dénommer_Récapitulatif_zone_ajustée
'==================================
'Création d'un classeur vierge, pour y recopier la BDD qui ne doit pas être ouverte si on utilise l'instruction MailMerge :
'==================================
'Mémorisation du nom actuel pour y revenir tout à l'heure :
PRINCIP = ActiveWorkbook.Name
'Préparation du nom de fichier pendant qu'on est encore dans le classeur qui permet de le calculer :
NOMFICHIER = Range("DossierCourant") & "TEMP.xls"
Workbooks.Add
'On va donner un nom de classeur qui existe déjà : on désactive les messages d'erreur :
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=NOMFICHIER _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False Application.DisplayAlerts = True
'On renomme aussi la feuille :
Sheets("Feuil1").Name = "Récap"
'On mémorise le nom de la fenêtre pour y revenir tout à l'heure :
TEMPO = ActiveWorkbook.Name
'On retourne au modèle, pour y copier la plage BDD :
Windows(PRINCIP).Activate
Application.Goto Reference:="Récapitulatif_zone_ajustée"
Selection.Copy
Windows(TEMPO).Activate
'Et on la colle en valeur, puis en format, dans le classeur temporaire :
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells.EntireColumn.AutoFit
Application.CutCopyMode = False
'Par sous-programme, comme on l'a fait dans le modèle, on donne dans la copie un nom bien ajusté aux cellules remplies pour que le publipostage ne soit pas ralenti pour rien :
SP_Dénommer_Récapitulatif_zone_ajustée
'On sauve et on ferme :
ActiveWorkbook.Save
ActiveWorkbook.Close
Range("E2").Select
'==================================
'===============
'PUBLIPOSTAGE
'===============
Dim wdApp As Object
Dim wdDoc As Object
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
'Ouvrir le document
NOMDOC = Range("DossierCourant") & "Fiche_rappel.doc"
Set wdDoc = wdApp.Documents.Open(NOMDOC)
'Renseigner sa DataSource
With wdDoc.MailMerge
.OpenDataSource _
Name:=Range("DossierCourant") & "TEMP.xls", _
SQLStatement:="SELECT * FROM [Récapitulatif_zone_ajustée]"
'Pour que les champs affichent toujours leur valeur (et pas leur nom) :
.ViewMailMergeFieldCodes = False
'Pour mémoriser les champs utiles au publipostage électronique (et que les valeurs par défaut de l'outil 'Fusionner vers un message électronique' soient bien initialisées, ce qui évite à l'utilisateur de les retaper à chaque fois) :
.Destination = wdSendToEmail
.MailSubject = "Votre fiche"
'il faut choisir une seule des deux lignes suivantes (exclusives l'une de l'autre, il faut en mettre une en commentaires) :
'.MailFormat = wdMailFormatPlainText 'Soit le document est traduit en Format texte brut dans le corps du texte, et on perd toutes les mises en forme
.MailAsAttachment = True 'Soit le document est attaché en pièce jointe, mais on n'a aucun texte dans le corps du mail
.SuppressBlankLines = True
End With
'Une fois sous Word, c'est l'utilisateur qui contrôle ses fiches et qui lance soit l'impression, soit les mails, soit les deux. En quittant Word, il revient à Excel.
End Sub
Sub SP_Dénommer_Récapitulatif_zone_ajustée()
ActiveSheet.Unprotect
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
LARGEUR = Selection.Columns.Count
Range(Selection, Selection.End(xlDown)).Select
HAUTEUR = Selection.Rows.Count
ActiveWorkbook.Names.Add Name:="Récapitulatif_zone_ajustée", RefersToR1C1:="=Récap!R1C1:R" & HAUTEUR & "C" & LARGEUR
Range("E2").Select
ActiveSheet.Protect
End Sub