Ouverture d'un dossier spécifique depuis un document word en vba

Résolu/Fermé

jujuetd63 - Modifié le 4 juin 2020 à 09:32
jujuetd63 - 4 juin 2020 à 11:25

bonjour,
J'ai un document WORD dans lequel j'ai une macro qui fait l'assemblage de plusieurs autres documents WORD.

voici la macro:

Sub assemblageDoc()
 Dim dlgFile As FileDialog
  Dim nTotalFiles As Integer
  Dim nEachSelectedFile As Integer
  
 ChDir "D:\COMPTE.R\test macro\assemblage\"
  Set dlgFile = Application.FileDialog(msoFileDialogFilePicker)



  With dlgFile
    .AllowMultiSelect = True
    If .Show <> -1 Then
      Exit Sub
    Else
      nTotalFiles = .SelectedItems.Count
    End If
  End With
 
  For nEachSelectedFile = 1 To nTotalFiles
    Selection.InsertFile dlgFile.SelectedItems.Item(nEachSelectedFile)
    If nEachSelectedFile < nTotalFiles Then
      Selection.InsertBreak Type:=wdPageBreak
    Else
      If nEachSelectedFile = nTotalFiles Then
    
         
      Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="2"
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

      With ActiveDocument
      
        .TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _
            True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _
            LowerHeadingLevel:=3, IncludePageNumbers:=True, AddedStyles:="", _
            UseHyperlinks:=True, HidePageNumbersInWeb:=True, UseOutlineLevels:= _
            True
        .TablesOfContents(1).TabLeader = wdTabLeaderDots
        .TablesOfContents.Format = wdIndexIndent
       
    End With

        Exit Sub
      End If
    End If
  Next nEachSelectedFile

End Sub

à la ligne:
ChDir "D:\COMPTE.R\test macro\assemblage\"
Set dlgFile = Application.FileDialog(msoFileDialogFilePicker)

une boite de dialogue s'ouvre pour me permettre de choisir les documents.

Cette fenêtre m'oblige à rechercher le dossier ou se trouve mes documents (mon dossier s'appel "assemblage")et de sélectionner les documents à la main.

je voudrai remplacer cette commande par une qui me donne accès directement au contenu du dossier "assemblage". la sélection des documents peut resté manuelle cela me convient.

j' ai essayé avec unique la ligne "set...…" mes le fonctionnement est le même.
j'ai aussi essayé avec unique la ligne "ChDir……." mais il ne se passe rien, le code ne se fait pas et je n'ai pas d'erreur.

Pouvez vous m'aider?

Cordialement

A voir également:

Ouverture d'un dossier spécifique depuis un document word en vba
Signer un document word - Guide
Supprimer une page word - Guide
Mettre un mot de passe sur un dossier - Guide
Espace insécable word - Guide
Comment faire un organigramme sur word - Guide

5 réponses

Réponse 1 / 5

jordane45 Messages postés 38136 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 16 avril 2024 4 649
4 juin 2020 à 09:37

Bonjour,

Pour word, il me semble que tu peux faire un truc du genre avant d'ouvrir la fenêtre
https://docs.microsoft.com/fr-fr/office/vba/api/word.options.defaultfilepath

Application.Options.DefaultFilePath(wdDocumentsPath) = "D:\COMPTE.R\test macro\assemblage\"

Réponse 2 / 5

jujuetd63
4 juin 2020 à 09:54

je viens de faire plusieurs tests mais la fenêtre s'ouvre toujours sur "c:\......." la fenêtre par défaut que j'avais avant.

je sais que j'ai besoin de la variable "dlgFile" pour suite du code.
est il possible que les 3 lignes de code se perturbent l'une l'autre.

Application.Options.DefaultFilePath(wdDocumentsPath) = "D:\COMPTE.R\test macro\assemblage\"
ChDir "D:\COMPTE.R\test macro\assemblage\"
Set dlgFile = Application.FileDialog(msoFileDialogFilePicker)

Réponse 3 / 5

yg_be Messages postés 22692 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 16 avril 2024 1 471
4 juin 2020 à 10:05

bonjour,
https://docs.microsoft.com/fr-ch/office/vba/api/office.filedialog.initialfilename

Réponse 4 / 5

jujuetd63
4 juin 2020 à 10:28

je ne suis pas sure de tout comprendre dans l'exemple donné.

Mais je pense qu'il faut remplacer les 3 lignes citées plus haut par une versions modifie et adapté du code exemple.

Je me demande si cela fonctionnera avec le reste du code qui utile la même variable: Dim dlgFile As FileDialog.

je ne voudrai pas détruire le code que j'ai si j'ai mal compris l'exemple donnée.

Pouvez vous me confirmer que j'ai bien compris l'exemple merci.

Pour info, je débute sur VBA et je ne suis pas sure d'avoir toutes les bases pour tout comprendre en une foi.

yg_be Messages postés 22692 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 16 avril 2024 1 471
Modifié le 4 juin 2020 à 11:13

en repartant du code que tu as montré au départ, je suggère:
- de supprimer la ligne 6
- d'ajouter ceci après la ligne 7:

dlgFile.InitialFileName =    "D:\COMPTE.R\test macro\assemblage\"

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 5

jujuetd63
4 juin 2020 à 11:25

j'ai poursuivi mes test et j'ai obtenu un code qui fonctionne.

le voici:

Sub assemblageDoc()
 Dim dlgFile As FileDialog
  Dim nTotalFiles As Integer
  Dim nEachSelectedFile As Integer
  
  
  Set dlgFile = Application.FileDialog(msoFileDialogFilePicker)


  With dlgFile
  .InitialFileName = "D:\COMPTE.R\test macro\assemblage\"
    .AllowMultiSelect = True
    If .Show <> -1 Then
      Exit Sub
    Else
      nTotalFiles = .SelectedItems.Count
    End If
  End With
 
  For nEachSelectedFile = 1 To nTotalFiles
    Selection.InsertFile dlgFile.SelectedItems.Item(nEachSelectedFile)
    If nEachSelectedFile < nTotalFiles Then
      Selection.InsertBreak Type:=wdPageBreak
    Else
      If nEachSelectedFile = nTotalFiles Then
    
         
      Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="2"
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

      With ActiveDocument
      
        .TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _
            True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _
            LowerHeadingLevel:=3, IncludePageNumbers:=True, AddedStyles:="", _
            UseHyperlinks:=True, HidePageNumbersInWeb:=True, UseOutlineLevels:= _
            True
        .TablesOfContents(1).TabLeader = wdTabLeaderDots
        .TablesOfContents.Format = wdIndexIndent
       
    End With

        Exit Sub
      End If
    End If
  Next nEachSelectedFile

End Sub

merci pour votre aide bonne journée

Newsletters