Problème dans l’automation d’un publipostage

**apt** · 28/10/2012, 21h47

Bonsoir à tous,

Dans les colonnes d'une feuille Excel, j'ai les étiquettes suivantes :

1- Colonne A : Matricule

2- Colonne B : Nom

3- Colonne C :Fonction

4- Colonne D : Service

5- Colonne E : Destination

6- Colonne F : Motif

7- Colone G : Etiquette

8- Colonne I : Réf

La feuille source :

Matricule Nom Fonction Service Destination Motif Etiquette Réf

650014747 Dupont Technicien Bâtiment D2 M1 x 6

680004578 Laurent Attaché administratif Compatibilité

750017915 Lajoie Technicien Informatique D1 M3 x

608945128 Durand Attaché administratif Compatibilité

Le fichier doc de fusion se presente ainsi :

Réf : … «Réf»…. du …«Date» ….

Matricule :……«Matricule»……………..
Nom :……«Nom»..…………………..
Fonction :……«Fonction»……………..
Service :……«Service»……………….
Destination :….. «Destination»…………
Motif :……«Motif»………………….

Je m'en sers du code suivant pour faire du publipostage.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
'Option Explicit
 
Sub Publipostage()
    Application.ScreenUpdating = False
    Chemin = ThisWorkbook.Path
    With Sheets("feuil1")
        .Activate
        NbreX = Application.CountIf(.Range(.[G2], .[G65536]), "x")
        If NbreX = 0 Then
            MsgBox "Il n'y a pas d'étiquette à extraire.", vbInformation + vbOKOnly
            .Range("A1").Select
            Exit Sub
        End If
    End With
 
    'Sheets(Array("feuil1", "Listes")).Copy
    Sheets("feuil1").Copy
    ActiveWorkbook.Close savechanges:=True, Filename:=Chemin & "\Temp.xls"
    ChDir ThisWorkbook.Path
    FileMailing = Application.GetOpenFilename("Fichiers Word (*.doc), *.doc", , "Ouvrir le document Word pour le mailing d'étiquettes ...")
    If FileMailing = False Then End
    'Si c'est OK on incrémente la référence
    [J2] = [J2] + 1
    ' Ouverture de Word
    Dim AppWord As Word.Application
    Set AppWord = New Word.Application
    AppWord.Visible = True 'False    'True
    Set DocWord = AppWord.Documents.Open(FileMailing)
    NomBase = Chemin & "\Temp.xls"
    With DocWord.MailMerge
        .OpenDataSource Name:=NomBase, _
                        Connection:="Driver={Microsoft Excel Driver (*.xls)};" & "DBQ=" & _
                                    NomBase & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [feuil1$] WHERE [ETIQUETTE] like 'x' OR [ETIQUETTE] like 'X'"
        'Spécifie la fusion vers un nouveau document (wdSendToPrinter= Vers l'imprimante)
        .Destination = wdSendToNewDocument
        '.SuppressBlankLines = True 'Il ne peut pas y voir de ligne blanche car on demande celle qui ont des croix
        'Prend en compte l'ensemble des enregistrements
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
    ' Activation du doucment principal de Publipostage et fermeture
    DocWord.Activate
    DocWord.Close savechanges:=False
    ' Affichage l'application Word
    AppWord.Visible = True
    Set DocWord = Nothing
    Set AppWord = Nothing
    ' Activation de l'onglet
    ' Effacement du fichier temporaire crée spécialement pour la fusion
    Kill Chemin & "\temp.xls"
    Application.ScreenUpdating = True
End Sub

Seulement j'ai deux problèmes :

1) En choisissant dans la feuille source Excel, deux lignes marquées par une croix "x", l'extraction vers le document Word de fusion, ne s'exécute que pour la première ligne marquée. La deuxième ligne de données est ignorée.

2) En choisissant de réaliser le publipostage ligne par ligne, la date du jour est inscrite une seule fois dans le premier document, et en répétant la tache une deuxième fois, la date n'apparait plus.

Une solution ?

Merci d'avance.

**Oliv-** · 29/10/2012, 09h55

Salut,
Ne faut-il pas enregistrer ton fichier excel avant de lancer le publipostage ?

**apt** · 29/10/2012, 11h48

Bonjour Oliv-,

Même dans ce cas, le traitement ne se fait que sur la première ligne.

le reste des lignes marquées pour la fusion, seront ignorées !

**Oliv-** · 29/10/2012, 12h39

Ton code marche très bien chez moi

**apt** · 29/10/2012, 15h40

Voila l'exemple que j'utilise en PJ.

**Oliv-** · 29/10/2012, 16h21

Je confirme !
En fait ta date ne se met que sur la ligne 2 car en-dessous c'est vide (dans excel)
tu peux t'affranchir de cela en insérant dans ton doc un champ date directement.

**apt** · 29/10/2012, 22h58

Salut,

Voila la date insérée directement dans mon doc :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MERGEFIELD "Date" \@ "dd/MM/yyyy" \* MERGEFORMAT

Manque-t-il quelque chose ?

**Oliv-** · 30/10/2012, 09h40

Salut,
si c'est un champs Word ca doit être

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

{ DATE   \* MERGEFORMAT}

MERGEFIELD fait référence à un champ extrait du fichier Excel. Tu peux aussi recopier vers le bas ta date dans Excel pour qu'elle soit sur toutes les lignes dans la colonne K.

En fait tes listes en COLONNES K à Q seraient mieux dans un autre onglet, car là elles peuvent interfèrer avec tes données.

Pour se faire tu les déplaces et tu les nommes (formule /"définir un nom")
ex ListeFonctions
dans tes menus déroulant tu remplaces le range par le nom de ta zone nommée précedemment
"=$M$2:$M$10" par "= ListeFonctions"

**apt** · 30/10/2012, 14h49

Bonjour Oliv-,

Ca marche bien.

En voulant trouver une solution au champ Réf, j'ai ajouté un code dans le Worksheet_Change lorsque je saisie une croix dans la colonne des étiquettes.

Seulement en cliquant sur le bouton "Publipostage", j'ai ce message d'erreur :

Les fonctionnalités suivantes ne peuvent pas être enregistrées dans des classeurs sans macro :

* Projet VB

Pour enregistrer un fichier avec ces fonctionnalités, cliquez sur No, puis sélectionner un type de fichier prenant en charge les macros dans la liste Type de fichier.

**Oliv-** · 30/10/2012, 15h25

Si tu veux enregistrer ton fichier au format xls 2007 il faut choisir le type de fichier .xlsm (avec macro)
En fait la copie de ton fichier destinée au publipostage est enregistrée au format 2007 mais avec une extension 2003 (xls).
Il faudrait corriger soit l'extention soit le type dans saveas voir l'aide
tu peux aussi ignorer le message

**apt** · 30/10/2012, 22h00

Bonsoir Oliv-,

J'ai essayé de virer le message d'erreur, en changeant le type de fichier à sauvegarder en xlsm, mais sans résultat :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWorkbook.Close savechanges:=True, Filename:=Chemin & "\Temp.xlsm"

Ensuite, la première version jointe fonctionnait sans message d'erreur !

Pourquoi c'est le cas pour cette deuxième version ?

**Oliv-** · 30/10/2012, 22h34

Ta 1 ère version ne comportait pas de macro ( dans la feuil)
L extension seule ne gère pas le type de fichier
ActiveWorkbook.SaveAs "C:\ron.xlsm", fileformat:=52
' 52 = xlOpenXMLWorkbookMacroEnabled = xlsm (with macro's in 2007-2010)

**apt** · 30/10/2012, 23h06

Re,

En sauvegardant le nouveau classeur créé sous l'extension xlsm, ça crée encore des messages d'erreur dans Temp.xlsm

Alors, ce fichier n'a pas besoin d'être sauvegarder avec les macros. Il sert simplement pour appliquer une requête SQL, après il sera détruit.

N'y a-t-il pas moyen d'éviter le message d'erreur en question ?

**Oliv-** · 31/10/2012, 09h52

Bonjour,
Tu as raison il n'y a pas d’intérêt à enregistrer les macros dans le fichier destiné au publipostage.

si tu es sûr que le fichier va être utilisé par des EXCEL 2007

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Option Explicit

Sub Publipostage()
Dim Chemin, NbreX, FileMailing
Dim DocWord As Word.Document
Dim NomBase

    Application.ScreenUpdating = False
    Chemin = ThisWorkbook.Path
    With Sheets("feuil1")
        .Activate
        NbreX = Application.CountIf(.Range(.[H2], .[H65536]), "x")
        If NbreX = 0 Then
            MsgBox "Il n'y a pas d'étiquette à extraire.", vbInformation + vbOKOnly
            .Range("A1").Select
            Exit Sub
        End If
    End With

    'Sheets(Array("feuil1", "Listes")).Copy
    Sheets("feuil1").Copy
    
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=Chemin & "\Temp.xlsx", FileFormat:=51
    ActiveWorkbook.Close savechanges:=True
    Application.DisplayAlerts = True
    
    ChDir ThisWorkbook.Path
    FileMailing = Application.GetOpenFilename("Fichiers Word (*.doc), *.doc", , "Ouvrir le document Word pour le mailing d'étiquettes ...")
    If FileMailing = False Then End
    'Si c'est OK on incrémente la référence
    'Sheets("Feuil2").[A2] = [A2] + 1
    ' et efface la croix de la colonne H
    With Sheets("Feuil1")
        '.Range(.Cells(2, 8), .Cells(.Rows.Count.End(xlUp).Row, 8)).ClearContents
        .Range(.[H2], .[H65536]).ClearContents
    End With
    ' Ouverture de Word
    Dim AppWord As Word.Application
    Set AppWord = New Word.Application
    AppWord.Visible = True    'False    'True
    Set DocWord = AppWord.Documents.Open(FileMailing)
    NomBase = Chemin & "\Temp.xlsx"
    With DocWord.MailMerge
        .OpenDataSource Name:=NomBase, _
                        Connection:="Driver={Microsoft Excel Driver (*.xls)};" & "DBQ=" & _
                                    NomBase & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [feuil1$] WHERE [ETIQUETTE] like 'x' OR [ETIQUETTE] like 'X'"
        'Spécifie la fusion vers un nouveau document (wdSendToPrinter= Vers l'imprimante)
        .Destination = wdSendToNewDocument
        '.SuppressBlankLines = True 'Il ne peut pas y voir de ligne blanche car on demande celle qui ont des croix
        'Prend en compte l'ensemble des enregistrements
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
    ' Activation du doucment principal de Publipostage et fermeture
    DocWord.Activate
    DocWord.Close savechanges:=False
    ' Affichage l'application Word
    AppWord.Visible = True
    Set DocWord = Nothing
    Set AppWord = Nothing
    ' Activation de l'onglet
    ' Effacement du fichier temporaire crée spécialement pour la fusion
    Kill Chemin & "\temp.xlsx"
    Application.ScreenUpdating = True
End Sub

Sinon tu pourrais aussi supprimer les macro avant l'enregistrement.

Pour info ton fichier Liste (v002).xls bien qu'avec l'extension xls est en fait au format 2007. (pour tester tu l'ouvres avec 7zip et tu verras un fichier xml=2007)

**apt** · 01/11/2012, 21h28

Merci ça marche Oliv-.

Pour régler le problème des cas "xls", il faut coder :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
ActiveWorkbook.CheckCompatibility = False
    ActiveWorkbook.SaveAs Chemin & "\Temp.xls", xlExcel8
    ActiveWorkbook.Close False

Maintenant, je ne sais pour quelle raison, les champs de fusion dans le document Word Lettres types1, DATE et TIME, ne se mettront plus à jour.

Problème dans l’automation d’un publipostage

Macros et VBA Excel

Discussions similaires

Partager

Partager