[XL-2002] Comptage de fichiers word depuis excel [Résolu]

[Pegase45]

Bonjour à tous,

J'ai un problème de comptage, depuis excel, du nombre de fichier word ouvert
J'ai créé une macro qui m'ouvre, à l'ouverture d'un classeur excel, un document word. Ce document word porte le même nom (sans l'extension bien sur) que le classeur exel. Pas de problème.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Sub Ouvrir_Word()
    FullName = ActiveWorkbook.FullName
    Chemin_Fich_doc = Replace(FullName, ".xls", ".doc")
 
    On Error Resume Next
'Vérification de l'ouverture
    Set Appli = GetObject(, "Word.Application")
    Set WordDoc = Appli.Documents(Chemin_Fich_doc)
    If WordDoc Is Nothing Then
'Ouverture
        Set wrdApp = CreateObject("Word.Application")
        Set wrdDoc = wrdApp.Documents.Open(Chemin_Fich_doc)
        wrdApp.Visible = True
    Else
    Mess = MsgBox("Le document word est déjà ouvert", vbOKOnly + vbInformation, "Attention")
    End If
    On Error GoTo 0
End Sub

Ensuite pour pouvoir fermer ce document word avant de fermer le classeur excel, j'ai cherché à faire la liste des word ouverts.

Code :

1
2
3
4
5
6
7
Sub liste_docsword()
Set appli_word = GetObject(, "Word.Application")
For Each docword In appli_word.Documents
    liste_docs_ouverts = docword.Name & vbCrLf & liste_docs_ouverts
Next docword
MsgBox liste_docs_ouverts
End Sub

Et là surprise !
1er essai
Si je commence par ouvrir mon classeur excel > TestExcel.xls par exemple, j'ouvre bien mon document TestExcel.doc.
Ensuite si j'ouvre un autre word TestWord.doc, par exemple, la macro "liste_docsword" va bien me donner dans le msgbox
TestExcel.doc
TestWord.doc

2ième essai
Si j'ouvre d'abord TestWord.doc puis TestExcel.xls (qui va m'ouvrir TestExcel.doc) la macro "liste_docsword" ne va me donner dans le msgbox que
TestWord.doc

TestExcel.doc est "oublié"
Pire si je supprime TestWord.doc et que je relance la macro "liste_docsword" sans même fermer le fichier excel celle-ci me trouve bien TestExcel.doc

Je ne comprends pas
Merci à ceux qui pourront m'aider et bon we
Pégase

[Qwazerty]

Salut

Tu devrais placer ta variable en porté public

Voila ce que ça donnerait en gardant la trame de ton code
Dans un module standard

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
 
Option Explicit
 
Public WrdDoc As Object
 
Sub Ouvrir_Word()
Dim Appli As Object
    FullName = ActiveWorkbook.FullName
    Chemin_Fich_doc = Replace(FullName, ".xls", ".doc")
 
    On Error Resume Next
    'Vérification de l'ouverture
    'ici tu regardes si une instance de Word est déjà lancé
    Set Appli = GetObject(, "Word.Application")
 
    'On vérifie qu'une instance est pointée
    'Et si ça n'est pas le cas, on en crée une
    If Appli Is Nothing Then Set Appli = CreateObject("Word.Application")
 
    'Ensuite on charge le fihcier Doc
    Set WrdDoc = Appli.Documents.Open(Chemin_Fich_doc)
    Appli.Visible = True
 
    'On verifie que le fichier est bien chargé
    'Et si ça n'est pas le cas, on suppose qu'il etait déjà ouvert
    If WrdDoc Is Nothing Then MsgBox "Le document word est déjà ouvert", vbOKOnly + vbInformation, "Attention"
 
End Sub

Maintenant WrdDoc pointe ton fichier Word et tu peux directement manipuler celui-ci


Pour facilité la programmation, tu peut activer les références à Word. Je regarde pour te faire une démo.

++
Qwaz

Re
Voila une solution avec le référencement activé.
Pour activer le référencement, tu vas dans VBa, menu Outils-> Références...
et tu coches Microsoft Word XX Object Library. XX étant la version installé sur le poste.

La déclaration de WrdDoc doit être placé dans un Module

Code :

1
2
 
Public WrdDoc As Word.Document

Le reste peut être placé n'importe ou dans ton fichier.

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
Sub Ouvrir_Word()
Dim Appli As Word.Application
Dim FullName As String, Chemin_Fich_Doc As String
 
 
    FullName = ThisWorkbook.FullName
    Chemin_Fich_Doc = Replace(FullName, ".xls", ".doc")
 
    On Error Resume Next
    'Vérification de l'ouverture
    'ici tu regardes si une instance de Word est déjà lancé
    Set Appli = GetObject(, "Word.Application")
    On Error GoTo 0
 
    'On vérifie qu'une instance est pointée
    'Et si ça n'est pas le cas, on en crée une
    If Appli Is Nothing Then Set Appli = CreateObject("Word.Application")
 
    'Ensuite on charge le fihcier Doc
    Set WrdDoc = Appli.Documents.Open(Chemin_Fich_Doc)
    Appli.Visible = True
 
    'Le fait que le document soit déjà ouvert ne déclenche pas d'erreur, il pointe simplement sur cette instance du fichier.
 
End Sub
 
 
Sub AutrePart()
Dim Appli As Word.Application
Dim TheDoc As Word.Document
 
'Ici on va fermé le fichier ouvert dans l'autre procédure (Ouvrir_Word)
If WrdDoc Is Nothing Then
    'Ici le fihcier n'a pas été ouvert la variable est vide (ou la variable a été vidé...)
    'Ici on peut faire une recherche des documents ouverts comme tu l'avais fait,
    'On pointe une instance de word
    On Error Resume Next
    Set Appli = GetObject(, "Word.Application")
    On Error GoTo 0
 
    'Si aucune instance existante, on quitte la procedure (aucun fihcier à fermer
    If Appli Is Nothing Then Exit Sub
 
    'Puis on pointe chaque fichiers ouverts
    For Each TheDoc In Appli.Documents
        'On regarde si le chemin correspond
        If TheDoc.FullName = Replace(ThisWorkbook.FullName, ".xls", ".doc") Then
            'Si c'est le cas, on pointe notre fichier
            Set WrdDoc = TheDoc
            'On quite cette boucle
            Exit For
        End If
    Next
End If
 
 
'on vérifie si un fichier a été trouvé
If Not WrdDoc Is Nothing Then
    'On pointe l'instance de Word qui contient notre fichier
    Set Appli = WrdDoc.Application
    'Sinon on ferme le fichier
    'On empêche l'instance de Word qui contient notre fichier d'afficher une alerte
    'donc pas de message pour nous demander si l'on veut sauvegarder les modification par exemple
    Appli.DisplayAlerts = False
    'On ferme en enregistrant
    WrdDoc.Close True
 
    'On relache le pointage
    Set WrdDoc = Nothing
 
    'On ferme l'instance si elle ne contient pas d'autre fichier ouvert
    If Appli.Documents.Count = 0 Then
        'Pas d'autre fichier
        Appli.Quit
    Else
        'Des fichier existent encore dans l'instance
        'on réactive l'affichage des alertes
        Appli.DisplayAlerts = True
    End If
 
    'et on relache le pointage
    Set Appli = Nothing
End If
 
End Sub

++
Qwaz

[Pegase45]

Merci beaucoup Qwaz d'avoir passé du temps sur mon problème.

Dès ta première réponse cela fonctionnait, et je pense avoir compris mon erreur qui consistait à ne pas vérifier qu'une instance de word était ou non pointé.
Super

Il me restait un problème
A la suite de ton 1er message j'ai activer les références à Word et cela me provoquait une erreur lorsque je lançais ma macro "FermerWord"

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub FermerWord()
Dim appword As Object
On Error Resume Next
    Name1 = ActiveWorkbook.Name
        Name = Replace(Name1, ".csv", ".doc")
        Name1 = Name
        Name = Replace(Name1, ".xls", ".doc")
    Set appword = GetObject(, "Word.Application")
    NbWord = appword.Documents.Count
    If appword Is Nothing Then
        appword.Documents.Open Filename:=NouveauWord.doc
    Else
        For i = 1 To NbWord
            Nom = appword.Documents(i).Name
            If appword.Documents(i).Name = Name Then
            appword.Documents(i).Close wdDoNotSaveChanges
        Exit For
                End If
        Next i
    End If
    If NbWord <= 1 Then appword.Quit
On Error GoTo 0
End Sub

J'obtenais l'erreur suivante
J'avoue ne pas comprendre pourquoi.
Sans vouloir abuser de ton temps, tu en as surment l'explication !

Par ailleur ta Macro "AutrePart" pour fermer word fonctionne parfaitement avec la référence à word activé.

J'ai apprécié tes commentaires particulièrement précis.
Encore un grand merci, tu me permets de progresser
Bon week end
Pégase

[Qwazerty]

Salut
Voila quelques commentaires de plus
Prend garde à l'utilisation de On error resume Next

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
Sub FermerWord()
'Pense à déclarer tes variables
Dim Name As String, Name1 As String
'Essai de toujours mettre au moins une majuscule dans tes nom de variable,
'ça permet en cas d'erreur dans le code de voir en un clin d'oeil si tu as bien orthographié tes nom de variables
Dim AppWord As Object
    'ThisWorkbook est préférable si bien sur ta macro se trouve dans le classeur auquel tu veux faire référence
    Name1 = ThisWorkbook.Name
    Name1 = Replace(Name1, ".csv", ".doc")
    'Name1 = Name
    Name = Replace(Name1, ".xls", ".doc")
 
    'Attention avec l'utilisation de On error goto next
    'Place le toujours au plus juste, ici pour ne par provoquer d'erreur si aucune instance trouvée
    'L'erreur ici est potentiellement attendue, par contre si tu place On error.. au début de ton code
    'VBA ne te fera remonter aucune erreur, ton code va dérouler en faisant n'importe quoi
    On Error Resume Next 'traduction "Lors d'une Erreur Aller à la ligne suivante" ;) sous entendu sans t'avertir
    Set AppWord = GetObject(, "Word.Application")
    On Error GoTo 0
    'Tu dois tester si AppWord pointe bien une instance avant de l'utiliser
    'NbWord = AppWord.Documents.Count 'On error resume next te cachait cette erreur
    'Je ne suis pas sûr de ce que tu souhaites faire dans la suite de ton code
    If AppWord Is Nothing Then
        'Pas logique, ici tu utilise AppWord alors qu'il ne contient pas d'instance de Word
        'Pour ouvrir une instance tu dois appeler create
        Set AppWord = CreateObject("Word.Application")
        'Mais je n'en vois pas l'utilité puisque tu cherches à fermé Word
        'Si AppWord est Nothing, il n'y a aucun document Word ouvert
 
        'Un nouveau document est ouvert automatiquement si c'est ce que tu voulais faire
        'AppWord.Documents.Open Filename:=NouveauWord.doc
    Else
        'il faut commencer la boucle à 0 et finir à count -1
        'tu peux aussi utiliser For Next comme dans mon exemple, cela fonctionne même sans les références
        For i = 0 To AppWord.Documents.Count - 1 'NbWord
            'Nom = AppWord.Documents(i).Name 'tu n'utilises Nom nulpart
            If AppWord.Documents(i).Name = Name Then
                AppWord.Documents(i).Close wdDoNotSaveChanges
                Exit For
            End If
        Next i
    End If
    'Attention ici si AppWord.Documents(i).Close etait le seul document ouvert
    'Il y a de forte chance que l'instance est été détruite par windows puisqu'inutile
    'Il éviter une remonté d'erreur
    On Error Resume Next
    If AppWord.Documents.Count = 0 Then AppWord.Quit
    On Error GoTo 0
    'If NbWord <= 1 Then AppWord.Quit
End Sub

Par contre, je ne vois pas le rapport entre la référence word et ton erreur, je ne pense pas que les deux soient liées.

++
Qwaz

Re
Avec les références activées

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
Sub FermerWordRef()
Dim AppWord As Word.Application 'As Object si tu n'utilise pas les réferences
Dim DocWord As Word.Document 'As Object si tu n'utilise pas les réferences
Dim strName As String
    'On modifi le nom  d'un .csv ou .xls en .doc
    strName = Replace(ThisWorkbook.Name, ".csv", ".doc")
    strName = Replace(strName, ".xls", ".doc")
 
    'On cherche une potentiel instance déjà ouverte
    On Error Resume Next
    Set AppWord = GetObject(, "Word.Application")
    On Error GoTo 0
 
    If Not AppWord Is Nothing Then
        'Une instance a été trouvée
        'On regarde si notre document est à l'interieur
        For Each DocWord In AppWord.Documents
            'On controle si le nom correspond
            If DocWord.Name = strName Then
                'On a trouvé notre fichier
                'On le ferme
                DocWord.Close False
                'On verifie si on peut fermer l'AppWord (si pas déjà fait par windows)
                'En faite contraorement a ce que je t'ai dis plus haut Windows ne le ferme pas tout seule
                'Mais bon on va quand même assurer le coup ;)
                On Error Resume Next
                If AppWord.Documents.Count = 0 Then AppWord.Quit
                'On Error Goto 0 'facultatif puisqu'on quitte la procédure prématurément
                Exit Sub
            End If
        Next
    End If
 
End Sub

++
Qwaz

[Pegase45]

Encore merci pour tes précieux conseils
Je marque en résolu
Pegase