.jakob@gmail.com
XLDnaute Nouveau
Bonjour
j'ai fait une macro en compilant des éléments de différents forum afin de réaliser un publipostage.
l'ensemble fonctionne jusqu'a l'enregistrement des documents.
Excel les enregistres toujours dans "mes documents", je n'arrive pas a lui faire utiliser le répertoire one drive defini que j'ai enregistré dans une variable
d'avance merci pour votre aide
j'ai fait une macro en compilant des éléments de différents forum afin de réaliser un publipostage.
l'ensemble fonctionne jusqu'a l'enregistrement des documents.
Excel les enregistres toujours dans "mes documents", je n'arrive pas a lui faire utiliser le répertoire one drive defini que j'ai enregistré dans une variable
d'avance merci pour votre aide
VB:
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & "\"
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
MsgBox ChoixDossier
End Function
Sub publipostage()
Dim j As String
Dim docWord As Object ' Word.Document
Set docWord = CreateObject("Word.Document")
Dim appWord As Object 'Word.Application
Set appWord = CreateObject("Word.Application")
Dim NomBase As String
fic_doc As String
cheminW As String
fichier_source As String
DocName As String
Dim nom_fichier As String
Nomsourcebase As String
message_boite As String
Dim fin As Integer
i As Integer
Dim wdSendToNewDocument, wdExportFormatPDF, wdExportOptimizeForPrint, wdExportAllDocumnt, wdExportCreateHeadingBookmarksent, wdExportDocumentConte
wdSendToNewDocument = 0
wdExportFormatPDF = 17
wdExportOptimizeForPrint = 0
wdExportAllDocument = 0
wdExportDocumentContent = 0
wdExportCreateHeadingBookmarks = 1
j = ActiveSheet.Name
'Choisir la source de donnees
message_boite = "Fichier Source tableau excel"
Nomsourcebase = Application.GetOpenFilename("Fichiers Excel (*.xlsm), *.xlsm", , message_boite)
If Nomsourcebase = False Then Exit Sub
'Choisir le document word
message_boite = "Fichier source word "
fic_doc = Application.GetOpenFilename("Fichiers Word (*.docx), *.docx", , message_boite)
If fic_doc = False Then Exit Sub
' Selectionner le chemin de sauvegarde
message_boite = "Dossier destiantion "
cheminW = ChoixDossier
Application.ScreenUpdating = False
fichier_source = ActiveWorkbook.Name
Set appWord = CreateObject("Word.Application") '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
.OpenDataSource Name:=Nomsourcebase, Connection:="Driver={Microsoft Excel Driver (*.xlsx)};" & "DBQ=" & Nomsourcebase & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [Base$]"
fin = .DataSource.RecordCount
End With
For i = 1 To fin
'fonctionnalité de publipostage pour le document spécifié
With docWord.MailMerge
.destination = wdSendToNewDocument
.SuppressBlankLines = True
'Prend en compte l'ensemble des enregistrements
With .DataSource
.FirstRecord = i
.LastRecord = i
End With
'Exécute l'opération de publipostage
.Execute Pause:=False
.DataSource.ActiveRecord = i 'execute le publipostage
DocName = "Attestation fiscale " & .DataSource.DataFields(3).Value
DocName = DocName & " " & .DataSource.DataFields(4).Value
DocName = DocName & " pour " & .DataSource.DataFields(9).Value
End With
nom_fichier = DocName & ".pdf"
Sheets("Base").Select
Cells(i + 1, 11).Select
Selection.Value = nom_fichier
With appWord.ActiveDocument
.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
.SaveAs cheminW
.Close False
End With
Next i
Sheets(j).Select
Application.ScreenUpdating = True
MsgBox ("Les attestations ont été généré dans le dossier")
'Fermeture du document Word
docWord.Close False
appWord.Quit
End Sub