Problème Word/Excel :(

[nefertari]

Bonsoir

Je rencontre un problème entre excel et word.

Dans le fichier Excel, j'ouvre un premier fichier Word

Code :

1
2
3
4
5
6
7
8
9
10
11
12
 
Dim wrdApp As Word.Application
 
If TypeName(wrdApp) <> "Application" Then
  Set wrdApp = CreateObject("Word.Application")
End If
 
wrdApp.Visible = True 
wrdApp.WindowState = wdWindowStateMaximize        wrdApp.Documents.Open ("C:\word\fic\Auto")  
wrdApp.Documents.Close  
 
  LanceMacroWORD = True

Lorsque le premier fichier Word est ouvert celui à une procédure qui ouvre après d'autres fichiers word en cascade.

Code :

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

Sub macro_fusion()
pasdos = 0

    On Error GoTo Message_erreur
    SendKeys "{O}"
    Documents.Open FileName:="C:Valeur.doc", ConfirmConversions:=False, _
        ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto
    On Error GoTo 0

    On Error GoTo Message_erreur_4
    With ActiveDocument.MailMerge
         .Destination = wdSendToNewDocument
         .MailAsAttachment = False
         .MailAddressFieldName = ""
         .MailSubject = ""
         .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With

    On Error GoTo 0
  ........

Si je lance le premier fichier word en cliquant sur "Activé Macro", je ne rencontre aucun problème.

Par contre, lorsque je pars de mon fichier Excel, je plante sur le ligne en rouge et les autres qui suivent.

J'ai supposé que c'etait à cause du message voulez-vous effectué le "select * from test.txt", donc j'ai ajouter SendKeys "{O}", juste avant l'ouverture du second fichier.

Hors j'ai toujours le problème, et j'ai le message suivant : " Erreur de lancement de la macro : 4605 : cette méthode ou propriété n'est pas disponible car une fenêtre du document n'est pas activé"

J'utilise office XP.

Si quelqu'un à une idée merci par avance.

[ouskel'n'or]

Laisse le temps à ton fichier de s'ouvrir en ajoutant DoEvents ici

Code :

1
2
    Documents.Open FileName:="C:Valeur.doc", ReadOnly:=True
    DoEvents

Autre problème dans Excel : Ta procédure se poursuit et tu fermes ton fichier aussitôt après l'avoir ouvert

wrdApp.Documents.Open ("C:\AutoDDI\SPC\Auto_DDI 320-321")
wrdApp.Documents.Close

Comme tu ouvres plusieurs documents dans Word, tu ne peux fermer chaque document que depuis Word. Remplace wrdApp.Documents.Close par un msgbox dans Excel

Code :

1
2
3
    Msgbox "Fusion terminée"
    Set wrdApp = Nothing
End sub

Ensuite, ferme tes documents depuis Word et ajoute un DoEvents après cette ligne dans ta macro Word

Code :

1
2
3
4
        .Execute Pause:=True
    End With
DoEvents
Activedocument.close false

Enfin, quand tous tes documents sont fusionnées, quitte Word depuis Word.

Code :

1
2
DoEvents
Application.quit

Tu retrouveras ton msgbox Excel à l'écran, un clic sur Ok et la macro pourra se poursuivre, et l'instance de l'appli Word sera supprimée.
A+

[nefertari]

Déjà merci de ton aide.

Cependant le problème reste le même, je n'arrive pas à sortir mon document entièrement. Mais maintenant, il s'arrête sur une autre ligne (en rouge).

Code :

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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
Sub macro_fusion()

    On Error GoTo Message_erreur
    SendKeys "{O}"
    Documents.Open FileName:="C:\valeur.doc", ConfirmConversions:=False, _
        ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto
    DoEvents
    On Error GoTo 0
 
******** Première Fusion de document ********
    On Error Resume Next
    With ActiveDocument.MailMerge
         .Destination = wdSendToNewDocument
         .MailAsAttachment = False
         .MailAddressFieldName = ""
         .MailSubject = ""
         .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
    DoEvents
    On Error GoTo 0
    Selection.WholeStory
    
******** Suppression du saut de section ********
    Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Count:=1, Name:=""
    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
 
******** boucle while pour la seconde fusion ********
   On Error GoTo Message_erreur_5
                     Open "C:\list.txt" For Input As 1
    On Error GoTo 0
    
    i = 0
    
    While Not EOF(1)
    ' On lit et mémorise dans nomdoc$ la ligne contenant le nom du fichier associé à ouvrir.
    Input #1, nomdoc$
    If nomdoc$ = "pasdossi" Then
        pasdos = 1
    Else
   
     nomdoc$ = "C:\" + nomdoc$ + ".DOC"
    
    On Error GoTo Message_erreur_2
    SendKeys "{O}"
    Documents.Open FileName:=nomdoc$, ConfirmConversions:=False, _
        ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto
    DoEvents
    On Error GoTo 0
    Selection.WholeStory
    nombre_section = Selection.Information(wdActiveEndSectionNumber) + 1
    
    On Error Resume Next
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .MailAsAttachment = False
        .MailAddressFieldName = ""
        .MailSubject = ""
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
    DoEvents
    
    On Error GoTo 0
    Selection.WholeStory

    Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Count:=1, Name:=""
    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
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=1
    
    Selection.WholeStory

    Selection.Cut
    
    ActiveDocument.Close False
    ActiveDocument.Close False 

    Selection.Paste
    End If
    Wend

    Close #1

    Doevents
    Application.ScreenUpdating = True
    Application.Quit

si quelq'un à une idée, merci par avance.

[ouskel'n'or]

C'est une erreur ou tu cherches à fermer deux documents ?
Ceci dit, quand tu mets

Selection.Cut

le pb est le même que pour fermer ton document, tu dois laisser le temps au système de placer le texte sélectionné en mémoire. Ajoute DoEvents sur la ligne suivante.
Idem après paste et chaque "close", avant de quitter word.

[Heureux-oli]

Si c'est pour fermer tous les documents ouverts

Code :

Documents.close

[nefertari]

merci de votre aide.

mais je vais trouver une autre solution.