Discussion :

[dany13]

Bonjour à tous,

j'ai un petit souci dans ma macro qui fait la chose suivante :
- Parcourt le contenu d'un répertoire de fichier .doc
- ouvre les .doc 1 après l'autre
- effectue une copie du contenu
- et au final colle la total dans un autre fichier word

Etant donné que application.FileSearch ne fonctionne plus à partir de la v2007, j'utilise Dir() pour effectuer le parcourt.

Voici mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Sub MonExemple()
Dim FichierEnCours, FichierCourant, FichierEnCoursComplet
Dim FichierTmpName, NewDocName
Dim NewDoc As Boolean
Dim Wrd As Object
 
' Renvoie le nom de fichier .doc trouvé et si plusieurs fichiers existent dans le repertoire, le premier fichier trouvé est renvoyé.
FichierEnCours = Dir("c:/essai/*.doc")
Do While Len(FichierEnCours) > 0
    MsgBox FichierEnCours
    ' suppression temporaire de l'update automatique des links (évite l'apparition d'un warning message à chaque ouverture d'un fichier doc)
    Options.UpdateLinksAtOpen = False
    ' ouverture du fichier sans le rendre visible
    FichierEnCoursComplet = "c:/essai/" & FichierEnCours
    Documents.Open Filename:=FichierEnCoursComplet, Visible:=True, _
                ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
                PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
                WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
                wdOpenFormatAuto
 
    FichierCourant = ActiveDocument.Name
    If Not NewDoc Then 'Je ne crée un nouveau document au modèle que s'il n'existe pas
       'Créer et ouvrir un document en utilisant le modèle attaché au document actif
        FichierTmpName = ActiveDocument.AttachedTemplate.FullName
        Documents.Add Template:=FichierTmpName, NewTemplate:=True
        NewDocName = ActiveDocument.Name
        NewDoc = True ' On ne passe ici qu'une fois
    End If
 
    'Retour dans le document à copier
    Documents(FichierCourant).Activate
 
' CODE NE FONCTIONNE PAS, REMPLACÉ par GetObject *********            
    'Sélection de tout le document à copier
    'Selection.WholeStory         
    'Copie de toutes les données
    'Selection.Copy
 
'CODE DE REMPLACEMENT
    Set Wrd = GetObject(, "word.Application")
    Wrd.ActiveDocument.Select
    Wrd.Selection.WholeStory
    Wrd.Selection.Copy
 
 
    'Retour dans le nouveau document
    Documents(NewDocName).Activate
 
    'Colle toutes les données sauvegardées dans le document compilé
    Wrd.Selection.Paste
 
    'Fermeture du document (copié) sans sauvegarde
    Documents(FichierCourant).Close (wdDoNotSaveChanges)
 
    'On va en fin du doc créé pour être en position de recevoir la nouvelle copie
    Wrd.Selection.EndKey Unit:=wdLine
 
    'Réactivation de l'option update automatique des liens
    Options.UpdateLinksAtOpen = True
 
    ' Appelle de nouveau Dir sans argument pour renvoyer le fichier *.doc suivant dans le même dossier.
   FichierEnCours = Dir
Loop
 
'Mise à jour général de toutes les données linkées
Documents.Open Filename:=ThisWorkbook.path & "\MonFichierGlobal.doc", ConfirmConversions:=False _
            , ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
            PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
            WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
ActiveDocument.Content.Select
Wrd.Selection.Fields.Update
 
End Sub

Il ne se passe rien et mon fichier "MonFichierGlobal.doc" est desesperement vide

Que fais je de mal????

Merci pour vos lumières

++

[Theze]

Bonjour,

Tu devrais poster dans le forum VBA Word, ici tu es dans VBA Excel.

Hervé.

[dany13]

Bonjour à tous!

Theze, je poste ici parce que je suis dans Excel! Ma macro est une partie du traitement que j'effectue.

D'ailleurs, concernant mon code, en fait j'ai bien tous mes fichiers word qui se concatenent en un...mais c'est un .dotx!!! Je ne comprend pas à quel endroit il génère cela, ...enfin je pense que c'est au niveau du fichier modèle? Une idee?

Merci par avance

[dany13]

Bonjour à tous!

Pour information j'ai pu me sortir de mon probleme, je vous met mon morceau de code pour celles et ceux qui se retrouveraient dans le même cas que moi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Sub ConcatenerFichiersWrd()
Dim FichierEnCours, FichierCourant, FichierEnCoursComplet
Dim FichierTmpName, NewDocName, FichierGlobal
Dim NewDoc As Boolean
Dim Wrd, WrdOuvre As Object
Dim Msg, Style, Title, Help, Ctxt, Response
Dim DocGlobal As Word.Document
 
Set Wrd = GetObject(, "word.Application")
 
' Renvoie le nom de fichier .doc trouvé et si plusieurs fichiers existent dans le repertoire, le premier fichier trouvé est renvoyé.
FichierEnCours = Dir("C:/MonRepTemp/*.doc")
Do While Len(FichierEnCours) > 0
    MsgBox FichierEnCours
    ' ouverture du fichier sans le rendre visible
    FichierEnCoursComplet = "C:/MonRepTemp/" & FichierEnCours
    Documents.Open Filename:=FichierEnCoursComplet, Visible:=True, _
                ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
                PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
                WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
                wdOpenFormatAuto
 
    FichierCourant = ActiveDocument.Name
    If Not NewDoc Then 'Je ne crée un nouveau document au modèle que s'il n'existe pas
       'Créer et ouvrir un document en utilisant le modèle attaché au document actif
'        FichierTmpName = ActiveDocument.AttachedTemplate.FullName
 '       Documents.Add Template:=FichierTmpName, NewTemplate:=True
  '      NewDocName = ActiveDocument.Name
   '     MsgBox "Mon NewDocName : " & NewDocName
        Set DocGlobal = Wrd.Documents.Add(DocumentType:=wdNewBlankDocument)
        NewDoc = True ' On ne passe ici qu'une fois
    End If
 
    'Retour dans le document à copier
    Documents(FichierCourant).Activate
 
    Wrd.ActiveDocument.Select
    Wrd.Selection.WholeStory
    Wrd.Selection.Copy
 
 
    'Retour dans le nouveau document
    'Documents(NewDocName).Activate
    Documents(DocGlobal).Activate
    'Colle toutes les données sauvegardées dans le document compilé
    Wrd.Selection.Paste
 
    'Fermeture du document (copié) sans sauvegarde
    Documents(FichierCourant).Close (wdDoNotSaveChanges)
 
    'On va en fin du doc créé pour être en position de recevoir la nouvelle copie
    Wrd.Selection.EndKey Unit:=wdLine
 
    'Réactivation de l'option update automatique des liens
    'Options.UpdateLinksAtOpen = True
 
    ' Appelle de nouveau Dir sans argument pour renvoyer le fichier *.doc suivant dans le même dossier.
   FichierEnCours = Dir
Loop
FichierGlobal = ThisWorkbook.path & "\BordereauJustificatif_" & Format(Date, "yyyy-mm-dd") & ".doc"
Wrd.Application.ActiveDocument.SaveAs FichierGlobal
 
'on ferme le modele & libere
DocGlobal.Close
Set DocGlobal = Nothing
 
'Wrd.Application.Quit
Set Wrd = Nothing
 
MsgBox ("Le bordereau justificatif a été crée")
 
'Pour vider le presse papier
 
OpenClipboard 0&
EmptyClipboard
CloseClipboard
 
Msg = "Souhaitez-vous Ouvrir le fichier bordereau ?"    ' Définit le message.
Style = vbYesNo    ' Définit les boutons.
Title = "Message Important "    ' Définit le titre.
 
' Affiche le message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then    ' L'utilisateur a choisi Oui.
 
    Set WrdOuvre = GetObject(, "word.Application")
    'Rendre Word Visible
    WrdOuvre.Visible = True
    Documents.Open Filename:=FichierGlobal, ReadOnly:=False
End If
 
End Sub

Et le code des fonctions suivantes à mettre en début du code du module et qui permet de vider le presse-papier :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Option Explicit
'**********************************************************************************
'DECLARATION FONCTIONS UTILISÉES POUR VIDER LE PRESSE-PAPIER
'**********************************************************************************
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

Voilà!
Bonne journée à tous!