Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Macro excel spécifier chemin de sauvegarde one drive

.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


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
 

fanch55

XLDnaute Barbatruc
bonjour
oui c'est ca !
j'ai l'impression qu'il ne tient pas compte de mon saveAs !
il enregistre toujours les pdf dans "mes documents"

Le saveAs tente de sauvegarder votre document word modifié sous un autre nom indiqué par cheminW.
Or CheminW tel qu'il a été chargé ne donne qu'un emplacement (Dossier), pas un nom complet de fichier,
je suis même étonné que le saveas ne se plante pas .

C'est le .ExportAsFixedFormat OutputFileName:=(nom_fichier) qui crée les fichiers PDF .
nom_fichier tel qu'il a été construit est le nom simple du fichier, pas le nom complet avec son dossier de stockage.

Essayez plutôt de faire :
VB:
    With appWord.ActiveDocument
        .ExportAsFixedFormat OutputFileName:=(CheminW & "\" & 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

Nota: toutes les variables retournées par un choix de dossier doivent être de type Varian
 

.jakob@gmail.com

XLDnaute Nouveau
Bonjour
ca fonctionne merci bcp pour ton aide.
j'ai compris du coup mon erreur
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…