Macro publipostage Excel vers Word
Bonjour à tous,
Je suis nouvelle sur le forum.
Voici mon problème:
Je cherche à faire une macro avec un bouton placé sur une feuille Excel, contenant un tableau avec des infos. Quand je clique sur le bouton, je veux que toutes mes lignes forment chacune un fichier Word (publipostage) que je possède en modèle et que tous ces fichiers Word soient enregistrés dans un même dossier. Sachant que 1 modèle Word correspond à une feuille Excel, je possède 3 feuilles Excel, j'ai donc 3 modèle Word.
Ne comprenant pas grand chose aux macros, pouvez vous m'indiquer si cela est possible ?
Et pourriez vous m'aider.
Vous trouverez en pièce jointe, mes le fichier Excel et 2 des 3 modèles Word pour le publipostage.
Merci d'avance.
Bonjour à tous,
J'ai un peu avancer sur ma macro, en utilisant une autre macro. Par contre ça n'est pas exactement ce que je souhaiterais.
Les points noirs sont les suivants:
1- si je rajoute une ligne dans mon classeur excel, elle n'est pas prise en compte dans le publipostage.
2- je souhaiterais que le répertoire où sont situés mes fichiers word s'ouvre automatiquement.
3- si on appuie sur le bouton, j'aimerais que la macro écrase automatiquement le fichier word même si celui-ci existe sans demander une confirmation.
4- je souhaiterais également que le nom de mes fichiers word porte le nom du site, c'est à dire FichesADSL_"nomsite" (que le nom du site soit pris dans ma colonne A du ficher excel ou le titre du fichier word.
5- j'ai un problème, le fichier word généré apparaît dans le gestionnaire des tâches alors que je mon document word n'est pas ouvert.
6- toutes le lignes de mon tableau génèrent un seul fichier word, alors qu'il faudrait qu'elles génèrent un fichier chacune.
Pouvez vous m'indiquez si tout cela est possible et pouvez vous m'aider.
Merci à tous.
Bonjour à tous,
J'ai résolu deux de mes problèmes:
2- La ligne suivante ouvre automatiquement mon dossier:
Shell "c:\windows\explorer.exe D:\MACRO\Fiches ADSL", vbNormalFocus
5- Les lignes suivantes ferment le fichier et word:
WordDoc.Close
WordApp.Quit
Cordialement,
Bonjour à tous,
1- Les lignes suivantes permettent d'enregistrer les modifications de la du fichier excel, sans demander une confirmation:
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="D:\MACRO\Liste LignesTEST.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
Par contre je ne trouve pas de réponse à ma 6e question:
Tous mes enregistrements se trouvent dans un seul fichier Word, hors j'aimerais qu'il y ai un fichier par enregistrement:
Voici ma macro:
Option Explicit
Public Const wdDefaultFirstRecord = 1
Public Const wdDefaultLastRecord = -16
Sub Publipostage()
Dim Base As String, Model As String, Fiche As String, Rep As String
Dim WordApp As Object ' Word.Application
Dim WordDoc As Object ' Word.Document
Application.ScreenUpdating = False
Base = ActiveWorkbook.Path & "\Liste LignesTEST.xlsm"
Model = ActiveWorkbook.Path & "\Fiche modèle ADSL.docx"
Rep = ActiveWorkbook.Path & "\Fiches ADSL\"
If Not ExisteRep(Rep) Then MkDir Rep
Fiche = Rep & "Fiche ADSL_" & Format(Now(), "yyyymmddhhmm")
' Mise à jour du fichier de données Excel
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="D:\MACRO\Liste LignesTEST.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False
Set WordDoc = WordApp.Documents.Open(Model, ReadOnly:=False)
With WordDoc.mailMerge
'Ouvre la base
.OpenDataSource Name:=Base, Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
"DBQ=" & Base & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [ADSL$]"
.suppressBlankLines = True
With .DataSource
.firstRecord = wdDefaultFirstRecord
.lastRecord = wdDefaultLastRecord
End With
'Exécute l'opération de publipostage
.Execute Pause:=False
End With
WordDoc.Application.ActiveDocument.SaveAs Fiche
'WordApp.Application.Quit
WordDoc.Close
WordApp.Quit
Application.ScreenUpdating = True
MsgBox "Fiches ADSL créées"
'Ouvre le répertoire
Shell "c:\windows\explorer.exe D:\MACRO\Fiches ADSL", vbNormalFocus
End Sub
Function ExisteRep(Model As String) As Boolean
On Error Resume Next
ExisteRep = GetAttr(Model) And vbDirectory
End Function
Pourriez vous m'aider?
Cordialement,
Bonjour,
Je souhaiterais créer un fichier par enregistrement pour cette macro:
Option Explicit
Public Const wdDefaultFirstRecord = 1
Public Const wdDefaultLastRecord = -16
Sub Publipostage()
Dim Base As String, Model As String, Fiche As String, Rep As String
Dim WordApp As Object ' Word.Application
Dim WordDoc As Object ' Word.Document
Application.ScreenUpdating = False
Base = ActiveWorkbook.Path & "\Liste LignesTEST.xlsm"
Model = ActiveWorkbook.Path & "\Fiche modèle ADSL.docx"
Rep = ActiveWorkbook.Path & "\Fiches ADSL\"
If Not ExisteRep(Rep) Then MkDir Rep
' Mise à jour du fichier de données Excel
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="D:\MACRO\Liste LignesTEST.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False
Set WordDoc = WordApp.Documents.Open(Model, ReadOnly:=False)
With WordDoc.MailMerge
'Ouvre la base
.OpenDataSource Name:=Base, Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
"DBQ=" & Base & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [ADSL$]"
.suppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
'Exécute l'opération de publipostage
.Execute Pause:=False
End With
Fiche = Rep & "Fiche ADSL_" & Range("$A2")
WordDoc.Application.ActiveDocument.SaveAs Fiche
'WordApp.Application.Quit
WordDoc.Close
WordApp.Quit
Application.ScreenUpdating = True
MsgBox "Fiches ADSL créées"
'Ouvre le répertoire
Shell "c:\windows\explorer.exe D:\MACRO\Fiches ADSL", vbNormalFocus
End Sub
Function ExisteRep(Model As String) As Boolean
On Error Resume Next
ExisteRep = GetAttr(Model) And vbDirectory
End Function
Je mets en pièce jointe mes 2 fichiers.
Pourriez vous m'aider car la je n'y arrive pas?
Cordialement,
Bonjour à tous,
Personne pour m'aider. Je ne trouve toujours pas.
Cordialement,
Bonsoir,
si vous n'avez pas encore trouvé la solution, je vous propose celle ci :
en fait, il suffit d'ajouter une boucle for next encadrant les ordres de publipostages dont le compteur correspondra aux lignes excel et de fusionner un à un les enregistrements
supposons que la plage excel avec titre soit nommée BDDExcel
derniereligneexcel = bddexcel.rows.count
for cptexcel = 2 to derniereligneexcel' 2 car on ne fusionne pas la ligne de titre bien sur
With .DataSource
.FirstRecord = cptexcel
.LastRecord = cptexcel
End With
'Exécute l'opération de publipostage
.Execute Pause:=False
End With
Fiche = Rep & "Fiche ADSL_" & Range("$A2")
WordDoc.Application.ActiveDocument.SaveAs Fiche
'fermeture du fichier créé
WordDoc.Close
next cptexcel
voilà, j'espère avoir été clair et aidant
Bonjour,
Merci pour votre reponse.
La seule solution que j'ai trouvé, c'est de faire une macro par ligne.
J'ai nommé aucune plage.
Après quelle ligne j'insère vous 2 première ligne?
Voici ce que donne ma macro pour une ligne:
'Nom de la macro
Sub Publipostage_ADSL_L1()
'Déclaration des variables
Dim Base As String, Model As String, Fiche As String, Rep As String
Dim WordApp As Object 'Word.Application
Dim WordDoc As Object 'Word.Document
'Fige l'écran pour plus de rapidité de la macro
Application.ScreenUpdating = False
'Affectation des variables aux différents fichiers
Base = ActiveWorkbook.Path & "\Liste Lignes ADSL-SDSL.xlsm"
Model = ActiveWorkbook.Path & "\Modèles\Fiche modèle ADSL.docx"
Rep = ActiveWorkbook.Path & "\Fiches ADSL\"
'Sauvegarde du fichier de données Excel avec les dernières modifs saisies
Application.DisplayAlerts = False 'Désactive la fenêtre de sauvegarde
ActiveWorkbook.SaveAs Filename:="M:\3. INFORMATIQUE\3.4 Info matériels\3.4.14 Inventaire ADSL - SDSL\3.4.1 IDF Paris Est\Liste Lignes ADSL-SDSL.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True 'Réactive la fenêtre de sauvegarde
'Création d'un nouveau fichier Word
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False 'Cache la fenêtre Word
Set WordDoc = WordApp.Documents.Open(Model, ReadOnly:=False) 'Récupération du modèle
With WordDoc.MailMerge
'Ouvre la base
.OpenDataSource Name:=Base, Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
"DBQ=" & Base & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [ADSL$]"
.suppressBlankLines = True 'Suppression des lignes blanches
With .DataSource
.FirstRecord = 1 'Publipostage sur l'enregistrement défini
.LastRecord = 1 'Publipostage sur l'enregistrement défini
End With
'Exécute l'opération de publipostage
.Execute Pause:=False
End With
'Sauvegarde du fichier avec le nom du site colonne A et heure, minutes, pour les sites contenant plusieurs lignes
Fiche = Rep & "Fiche ADSL_" & Sheets("ADSL").Range("$A2") & "_" & Sheets("ADSL").Range("$D2") & "_" & Format(Date, "ddmmyyyy") & Format(Time, "hhmm")
WordDoc.Application.ActiveDocument.SaveAs Fiche
'Ferme le document et quitte Word
WordDoc.Close
WordApp.Quit
'Message "Fiche ADSL créée"
MsgBox "Fiche ADSL créée"
'Ouvre le répertoire dans lequel seront enregistrées les fiches
Shell "c:\windows\explorer.exe M:\3. INFORMATIQUE\3.4 Info matériels\3.4.14 Inventaire ADSL - SDSL\3.4.1 IDF Paris Est\Fiches ADSL", vbNormalFocus
End Sub
Bonjour
en fait tu as fait presque tout le travail
il te faut définir quelques compteurs et le reste n'est pas très compliqué
par contre, pour ma part, je préfère travailler avec des zones nommées dans excel, c'est plus simple et plus précis
dim Wcpt as long
dim nbligne as long
...
With WordDoc.MailMerge'
'Ouvre la base
.OpenDataSource Name:=Base, Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
"DBQ=" & Base & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [ADSL$]"
.suppressBlankLines = True 'Suppression des lignes blanches
doevents
.Destination = wdSendTodocument
With .DataSource'récupère le nombre total d'enregistrements
nbligne = wdDefaultLastRecord
End With
End With
for Wcpt = 2 to nbligne 'on commence à 2 pour ne pas prendre les titres
With WordDoc.MailMerge
With .DataSource
.FirstRecord = wcpt 'Publipostage sur l'enregistrement défini
.LastRecord = wcpt 'Publipostage sur l'enregistrement défini
End With
.Execute Pause:=False'Exécute l'opération de publipostage
End With
doevents
'définition du nom de fichier actif (documentn) pour le sauvegarder
Fiche = Rep & "Fiche ADSL_" & Sheets("ADSL").Range("$A2") & "_" & Sheets("ADSL").Range("$D2") & "_" & Format(Date, "ddmmyyyy") & Format(Time, "hhmm")
WordDoc.Application.ActiveDocument.SaveAs Fiche 'sauvegarde le document résultat qui est actif avec le nom généré
WordDoc.Application.ActiveDocument.Close 'ferme le document actif et revient donc au document de fusion
doevents
next wcpt 'incrémentation et on recommence jusqu'au dernier
WordDoc.Close
WordApp.Quit
'Message "Fiches ADSL créées"
MsgBox "Fiche ADSL créée"