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.

244liste-lignestest.xlsx (13.86 Ko)

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.

225liste-lignestest.xlsm (23.89 Ko)

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,

236liste-lignestest.xlsm (26.34 Ko)

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"
Rechercher des sujets similaires à "macro publipostage word"