miguelangelo
XLDnaute Occasionnel
Bonjour,
je retente ma chance en faisant un poste sur le sujet...
voilà, j'essaye de réadapter une macro pour cadrer avec mon besoin mais j'ai bcp de mal.
dans mon fichier de base, j'ai la macro suivante :
(de loin, je dirais qu'elle copie donc l'onglet infos dans un ficher excel sur le même répertoire, puis elle ouvre le doc word de fusion dans lequel tous les parametres de publipostage existent déja.)
Mon souci se trouve dans la zone rouge, il n'arrive pas à se connecter à la source (erreur vba). je mets le fichier temp qui constitue la source du publipostage
Sub publipostage()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Chemin = ThisWorkbook.Path
'Sheets(Array("feuil1", "Listes")).Copy
Sheets("infos").Select
range("A1:AF3").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.Close savechanges:=True, Filename:=Chemin & "\Temp.xls"
ChDir ThisWorkbook.Path
FileMailing = Application.GetOpenFilename("contrat Prestation (*.docx), *.docx", , "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 'CP ville' 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
je retente ma chance en faisant un poste sur le sujet...
voilà, j'essaye de réadapter une macro pour cadrer avec mon besoin mais j'ai bcp de mal.
dans mon fichier de base, j'ai la macro suivante :
(de loin, je dirais qu'elle copie donc l'onglet infos dans un ficher excel sur le même répertoire, puis elle ouvre le doc word de fusion dans lequel tous les parametres de publipostage existent déja.)
Mon souci se trouve dans la zone rouge, il n'arrive pas à se connecter à la source (erreur vba). je mets le fichier temp qui constitue la source du publipostage
Sub publipostage()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Chemin = ThisWorkbook.Path
'Sheets(Array("feuil1", "Listes")).Copy
Sheets("infos").Select
range("A1:AF3").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.Close savechanges:=True, Filename:=Chemin & "\Temp.xls"
ChDir ThisWorkbook.Path
FileMailing = Application.GetOpenFilename("contrat Prestation (*.docx), *.docx", , "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 'CP ville' 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
Dernière édition: