Aide macro publipostage

Bonjour le forum,

Après pas mal de recherches sur le net et de nombreux coups de mains du forum (que je remercie encore, super boulot) , j'arrive sur la dernière ligne de mon projet.

J'arrive sur la phase de publipostage. J'ai trouvé une macro sur le net, je l'ai adaptée à mon fichier mais je rencontre un petit soucis.... le publipostage se lance bien mais uniquement le premier... pas les suivants!! Je pense qu'il faut rajouter un bout de code mais je ne vois pas quoi???

De plus le document word publiposté vient écraser le document word source (modèle) et cela est gênant... Ne serait-il pas possible que le nouveau document Word soit copier sur le bureau avec un nom??

Je vous joint en pièce jointe (zippé) le projet en question pour test.

Merci d'avance pour votre aide!

Re,

Après un essai plus approfondi de mon fichier, en réalité le publipostage fonctionne sans soucis ^^

Mais en réalité il manque une petite fonctionnalité pour cette macro pour qu'elle fasse exactement ce que je souhaiterais obtenir :

Serait-il possible de rajouter un bout de code pour que le fichier word publiposté soit enregistré en plusieurs fichiers pdf renommés selon le nom du .doc (à savoir info collectivités SINGULIER) - nom prénom de la ligne en question de la base Excel? dans un dossier "info collectivités dans le répertoire courant?

Exemple:

info collectivité Singulier - totototo.pdf

info collectivité Singulier - tatatata.pdf

info collectivité Singulier - tataroro.pdf

etc....

Je vous rejoint le dossier contenant les différents fichiers pour test car le précédent était pas bon...

Merci d'avance pour vos retours et votre aide...

Bonjour

ci joint une proposition de publipostage PDF a l'unité

les fichier pdf créés se trouvent dans le meme dossier ou se trouve le fichier Word source du publipostage

Fred

Bonjour fred2406!

Je vous remercie pour cette proposition.... Elle fonctionne à merveille et réalise exactement ce que je cherchais^^

J'étais déjà tomber sur un ancien post ou vous la proposiez (https://forum.excel-pratique.com/excel/macro-enregistrement-document-word-en-pdf-t69234.html

J'ai bossé un peu dessus et je pense avoir réussi à faire tout ce dont j'avais besoin....

Je reviendrais vers vous si je bloque mais en principe c'est OK!!

Bonne journée et encore merci pour tout le boulot!!

RE

c'est en effet le même code que fourni dans le post cité, avec deux trois modifications

bonne journée

Fred

Salut Fred,

Je me permets de revenir vers toi au sujet de ta macro sur le publipostage.

Alors celle-ci fait bien le boulot.... en revanche en fin de macro j'ai un message d'erreur comme quoi le "nom de fichier est incorrect"

Les fichiers sont bien crées en pdf mais ce message bloque la fin de la macro et du coup il faut fermer manuellement le Word modèle...

Je me retrouve avec cette partie du code en jaune :

.ExportAsFixedFormat OutputFileName:=(nom_fichier), _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=False, _
        CreateBookmarks:=wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=False, UseISO19005_1:=False

Aurais-tu une idée d'ou peut venir le bug??

Merci d'avance pour ta réponse.

BOnsoir

si le nom de fichier est incorrect... il faut fouiller de ce coté là....

essaye de mettre un espion sur la variable : nom_fichier

.ExportAsFixedFormat OutputFileName:=(nom_fichier), _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=False, _
        CreateBookmarks:=wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=False, UseISO19005_1:=False

et exécuter le code en mode pas à pas pour voir le contenu de cette variable qui doit visiblement posé problème...

je rappel que le nom doit comporter le chemin + nom du fichier + extension

fred

Re,

je te joints la macro en question dans son intégralité :

Private Sub CommandButton1_Click()

'--------------------------------------------------------------------------------
'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
'--------------------------------------------------------------------------------
Dim docWord As Word.Document
Dim appWord As Word.Application
Dim NomBase, fic_doc, cheminW, cheminZ, fichier_source, DocName As String
Dim nom_fichier, Nomsourcebase, message_boite As String
Dim fin, i As Integer

ChDir ActiveWorkbook.Path
'demande du fichier source W
'message_boite = "fichier source du publipostage"
'fic_doc = Application.GetOpenFilename("Fichiers Word (*.doc), *.doc", , message_boite)
 fic_doc = "C:\Users\Sam\Desktop\VERSION JUIN 2016\Envoi agents Mme-M.doc"

Application.ScreenUpdating = False
'recupération du chemin ou se trouve le doc W pour enregistrement des PDF au meme endroit
fichier_source = ActiveWorkbook.Name
cheminW = Dir(fic_doc)
cheminW = Replace(fic_doc, cheminW, "")
cheminZ = "C:\Users\Sam\Desktop\VERSION JUIN 2016\Envois Agents\"

'message_boite = "fichier contenant les nouveaux noms des comptes créers"
'Nomsourcebase = Application.GetOpenFilename("Fichiers Excel (*.csv), *.csv", , message_boite)
'sinon nom du fichier xls source en dure
NomBase = cheminW & "publi simple.xlsx"

Application.DisplayAlerts = False
Set appWord = New Word.Application
appWord.Visible = True
'Ouverture du document principal Word
Set docWord = appWord.Documents.Open(fic_doc)
With docWord.MailMerge
    'Ouvre la base de données le fichier excel doit avoir sa feuille nommée 'feuil1'
   .OpenDataSource Name:=NomBase, Connection:="Driver={Microsoft Excel Driver (*.xlsx)};" & "DBQ=" & NomBase & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [publi simple$]"
    fin = .DataSource.RecordCount
End With
For i = 1 To fin
    'fonctionnalité de publipostage pour le document spécifié
   With docWord.MailMerge
        'Spécifie la fusion vers un nouveau doc
       .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
            'Prend en compte uniquement l'enregistrement i
           With .DataSource
                .FirstRecord = i
                .LastRecord = i
            End With
        'Exécute l'opération de publipostage
       .Execute Pause:=False
        'recupère le nom et prenom de la personne 'colonnes 1 et 2 du fichier source excel
       .DataSource.ActiveRecord = i
        DocName = .DataSource.DataFields(1).Value
        DocName = DocName & " " & .DataSource.DataFields(2).Value
        'DocName = .DataSource.DataFields(2).Value
    End With
    nom_fichier = cheminZ & DocName & ".pdf"
    With appWord.ActiveDocument
        'export pdf
       .ExportAsFixedFormat OutputFileName:=(nom_fichier), _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=False, _
        CreateBookmarks:=wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=False, UseISO19005_1:=False
        'fermeture du fichier W sans enregistrement
       .Close False
    End With
Next i
Application.ScreenUpdating = True
'Fermeture du document Word
docWord.Close False
appWord.Quit

End Sub

    Private Sub CommandButton6_Click()

If MsgBox("Voulez-vous imprimer les pdf générés ?", vbExclamation + vbYesNo) = vbYes Then imprimer_PDF (cheminW)

    End Sub

Comme demandé j'ai placé un espion sur la variable "nom_fichier" et voilà la valeur qui ressort :

"C:\Users\Sam\Desktop\VERSION JUIN 2016\Envois Agents\ .pdf"

C'est bizarre car dans le code j'ai pourtant bien mis :

nom_fichier = cheminZ & DocName & ".pdf"

Dans l'attente de ton retour....

Un grand merci d'avance si tu peux m'éclairer car cela fait quelques jours que je bloque sur ce problème!!

Bonjour

le problème vient donc du fichier excel contenant les données de publipostage et non de la macro qui fait le publipostage.... car tu dois avoir une ligne incomplète a la fin de tableau... et dans les cellules des colonnes ou tu récupères le nom du nouveau fichier, elles sont vides

il faudrait vérifier le nombre de lignes de ton fichier et ce que te sort cette instruction :

fin = .DataSource.RecordCount

soit c'est toujours la même chose et tu as donc un enregistrement de trop et il faut faire

fin = .DataSource.RecordCount-1

soit une autre maniere de faire on test le contenu de doc name avant de faire l'enregsitrement

if DocName <> " " then
nom_fichier = cheminZ & DocName & ".pdf"
    With appWord.ActiveDocument
        'export pdf
      .ExportAsFixedFormat OutputFileName:=(nom_fichier), _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=False, _
        CreateBookmarks:=wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=False, UseISO19005_1:=False
        'fermeture du fichier W sans enregistrement
      .Close False
    End With
end if

fred

Bonjour,

Merci pour ce retour des plus complet....

En effet, ma base de données contient des lignes incomplètes, cela s'explique par le fait que je dois ajouter 2 colonnes de plus (contenant la date de la séance + date de la séance+1jour). Celles-ci sont ajoutées manuellement sur 100 lignes (pour voir large).Est-il possible d'ajouter ces 2 informations de manière automatiques à chaque fin de ligne crée par la macro? Ce qui dans ce cas là, supprimerait le problème de lignes vides dans ma base de données....

Dans l'attente de ton retour.

Un grand merci d'avance.

Bonne journée.

RE

oui je penses que c'est faisable mais la faut remettre dans le contexte..... car là comme cela je ne sais pas/plus........

mais je ne vois pas en quoi rajouter des colonnes cela fait des lignes vides...... mais bon sans savoir exactement ce que tu fais........

fred

RE,

dans l'idéal il faudrait qu'en fin de chaque ligne insérée dans l'onglet "publi simple" une cellule supplémentaire renseigne la date de la séance et une autre la date de la séance + 1 jour....

Je te redonne la macro qui permets la création de ces lignes en fonction d'un tableau de référence.

Sub dispatching_simple()

    Dim i, lg As Integer
    Dim ShS, ShD As Worksheet
    Application.ScreenUpdating = False

Set ShS = Sheets("saisie")
Set ShD = Sheets("publi simple")
'effacement des données presente dans la feuille publisimple
If ShD.Cells(Rows.Count, "A").End(xlUp).Row > 1 Then ShD.Range("A2:M" & ShD.Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
For i = 7 To ShS.Cells(Rows.Count, "P").End(xlUp).Row
If ShS.Cells(i, "P") = "Publipostage simple" Then
lg = ShD.Cells(Rows.Count, "A").End(xlUp).Row + 1
ShS.Range(ShS.Cells(i, "A"), ShS.Cells(i, "F")).Copy
ShD.Cells(lg, "A").PasteSpecial Paste:=xlPasteValues
ShS.Range(ShS.Cells(i, "H"), ShS.Cells(i, "H")).Copy
ShD.Cells(lg, "G").PasteSpecial Paste:=xlPasteValues
ShS.Range(ShS.Cells(i, "J"), ShS.Cells(i, "O")).Copy
ShD.Cells(lg, "H").PasteSpecial Paste:=xlPasteValues
    End If
    Next
'efface les bordures
ShD.Range("A2:N" & ShD.Cells(Rows.Count, "A").End(xlUp).Row).Borders.LineStyle = xlNone
ShS.Activate
    End Sub

A savoir que la date de la séance est renseignée dans la page de saisie en cellule C3.

Merci d'avance pour ton retour...

c'est bien de redonner la macro mais c'est mieux de fournir un fichier ....

fred

ok c'est pas faux quand on est dedans on se rend pas bien compte que du code balancé comme ça c'est pas toujours évident ^^

Donc voici le fichier en question.

Merci d'avance.

Re,

Bon le problème du nom de fichier incorrect vient d'être corrigé avec l'ajout de "-1" à la fin de la ligne :

fin = .DataSource.RecordCount

qui devient à présent :

fin = .DataSource.RecordCount - 1

Pourrais-tu m'en dire plus que je comprenne...??? Je ne vois pas comment je pourrais avoir un enregistrement de trop??

Mais c'est vrai que pendant les tests et les bugs, 2 fichiers Word s'ouvraient lors du publipostage et pas seulement mon modèle??

Et effectivement il y a aussi ce problème de ligne vide en plus.

Je pense avoir trouvé un moyen de le contourner en insérant la date de séance et la date de séance + 1jour dans la ligne modèle que j'insère dans mon tableau...

Il me reste plus qu'à adapter ton code pour rajouter ces 2 colonnes dans le copier/coller vers la feuille "publi simple" et je pense que cela devrait le faire... A voir si tu peux directement insérer ses données via la macro ^^

Dans l'attente de te lire. Bonne journée.

Et merci pour tout....

Bonjour

j'ai pas trop le tmps là pour voir pourquoi il y a des enregistrements de trop.... mais bon a chaque fois que j'essai d'ouvrir ton fichier en activant les macros, j'ai une erreur de DLL et mon excel plante....

voici cependant ta macro avec l'insertion des formules pour les dates....

Sub dispatching_simple()

Dim i, lg As Integer
Dim ShS, ShD As Worksheet
Application.ScreenUpdating = False
Set ShS = Sheets("saisie")
Set ShD = Sheets("publi simple")
'effacement des données presente dans la feuille publisimple
If ShD.Cells(Rows.Count, "A").End(xlUp).Row > 1 Then ShD.Range("A2:O" & ShD.Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
For i = 7 To ShS.Cells(Rows.Count, "P").End(xlUp).Row
    If ShS.Cells(i, "P") = "Publipostage simple" Then
        lg = ShD.Cells(Rows.Count, "A").End(xlUp).Row + 1
        ShS.Range(ShS.Cells(i, "A"), ShS.Cells(i, "F")).Copy
        ShD.Cells(lg, "A").PasteSpecial Paste:=xlPasteValues
        ShS.Range(ShS.Cells(i, "H"), ShS.Cells(i, "H")).Copy
        ShD.Cells(lg, "G").PasteSpecial Paste:=xlPasteValues
        ShS.Range(ShS.Cells(i, "J"), ShS.Cells(i, "O")).Copy
        ShD.Cells(lg, "H").PasteSpecial Paste:=xlPasteValues
        ShD.Cells(lg, "N").Formula = "='" & ShS.Name & "'!C3"
        ShD.Cells(lg, "O").Formula = "='" & ShS.Name & "'!C3+1"
    End If
Next
'efface les bordures
ShD.Range("A2:O" & ShD.Cells(Rows.Count, "A").End(xlUp).Row).Borders.LineStyle = xlNone
ShS.Activate
End Sub

a+

fred

Bonjour Fred,

Merci pour le retour macro, je vais essayer mais je pense pas qu'il y aura de soucis ^^

En revanche oui ce problème d'enregistrement est plus pénible ^^ de plus, j'ai pu constater que la mise à jour de la base de publipostage avait du mal...

Je m'explique : j'ai crée une base "publi simple" de 50 lignes

j'ai enlever quelques lignes et ré enregistrer la base sous le même nom

Pourtant Word continue de voir autant de lignes qu'au début et du coup la macro plante....

Du coup, j'ai joué sur la ligne

fin = .DataSource.RecordCount

pour enlever le nombre d'enregistrements en trop....

Pas de soucis si pas trop de temps.... j'aurais pas besoin de ce fichier pendant les 2 mois à venir^^ mais j'espère trouver une solution pour palier au problème.

Encore un grand merci pour toute ton aide et le temps passée sur mon fichier.

Bonne journée.

Si tu fais des "trous" au milieu du tableau c'est normal.....

essaye plutot la deuxième solution données a savoir :

soit une autre maniere de faire on test le contenu de doc name avant de faire l'enregsitrement

if DocName <> " " then
nom_fichier = cheminZ & DocName & ".pdf"
    With appWord.ActiveDocument
        'export pdf
     .ExportAsFixedFormat OutputFileName:=(nom_fichier), _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=False, _
        CreateBookmarks:=wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=False, UseISO19005_1:=False
        'fermeture du fichier W sans enregistrement
     .Close False
    End With
end if

fred

Bin justement non non pas de trou au milieu du tableau.....

J'ai fais ça "proprement".... j'ai supprimé les lignes dont je n'avais pas besoin, relancé la macro de publi et ré enregistré la base données.... ^^

La méthode de test du "DocName" a plantée chez moi.... le publipostage s'est lancé et ne s'est jamais arrêté ^^

Je referais un essai pour confirmer!!