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

Résolu
jujuetd63 -  
 jujuetd63 -
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

5 réponses

  2. jujuetd63
     
    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)
    0
  4. jujuetd63
     
    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.
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      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\"
      0

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

    Posez votre question
  6. jujuetd63
     
    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
    0