Problème dans l’automation d’un publipostage
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:
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.
