Discussion :

[Marino69]

Bonjour,

Je développe une macro qui utilise 3 fichiers source pour calculer un indicateur.

Mon besoin : tester si les fichiers source sont déjà ouverts (+ msg box d'alerte et stop)

La solution (code ci-dessous ):
- une fonction publique : Function IsFileOpen(FichierSource As String)
- appelée 3 fois, dans une procédure : Sub TestSiFichiersSourcesOuverts()

Le constat:
Le code ignore le 1er document et fonctionne parfaitement pour les 2 suivants
Le fichier ignoré est un fichier partagé :
- son nom lorsqu'il est fermé = fichier de suivi de lots 2019.xlsx --> c'est le nom saisi dans une cellule d'une feuille du FichierMacro (libellé OK pour le fonctionnement de la suite de la procédure)
- à l'ouverture il est nommé = fichier.xlsx [Partagé]

Ma tentative: intégrer le préfixe [Partagé] au nom du fichier utilisé par la fonction IsOpenFile
avant : If IsFileOpen(Chemin & FichierSource) Then .../...
après : If IsFileOpen(Chemin & FichierSource & " [Partagé]") Then .../...

Résultat :
Erreur d'exécution 53 : Fichier introuvable
La ligne surlignée est à la fin de la fonction "Error errnum"


Pourriez-vous m'aider à comprendre pourquoi ce fichier partagé ne pose pas de problème quand il est ouvert par la macro, mais est ignoré par cette procédure qui teste s'il est déjà ouvert?

D'avance tous mes remerciements,
Marino

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
Function IsFileOpen(FichierSource As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next
    filenum = FreeFile()
    
    Open FichierSource For Input Lock Read As #filenum
    Close filenum
    errnum = Err
    On Error GoTo 0
    
    Select Case errnum
       
        Case 0
         IsFileOpen = False
     
        Case 70
            IsFileOpen = True
       
        Case Else
            Error errnum  '--> Ligne surlignées en jaune lors de l'Erreur d'exécution 53 : Fichier introuvable
    End Select

End Function

Sub TestSiFichiersSourcesOuverts()
'A inserer dans TesteSiFichierExiste
'Pour tester si les fichiers sources sont déjà ouverts

Application.ScreenUpdating = False
 
'Etape 1 : Déclarer le chemin d'accès, le nom du fichier Destinataire,le Workbook et la feuille où sont indiqués les noms des fichiers sources
Chemin = ThisWorkbook.Path & "\"
Set Destinataire = ThisWorkbook
Set ListeDesFichiersSource = Destinataire.Sheets("Nom Fichiers Sources")

'Etape 2 : Tester si les fichiers sources sont ouvert - Si ouverts : message et stop

'Fichier Suivi QP ouvert ?
FichierSource = ListeDesFichiersSource.Cells(2, 2).Value
MsgBox ("Test si " & FichierSource & " est ouvert"), vbOKOnly + vbInformation, "TestSiFichiersSourcesOuverts"
    If IsFileOpen(Chemin & FichierSource & " [Partagé]") Then   '---> En rouge préfixe ajouté qui provoque Erreur d'exécution 53 : Fichier introuvable (sans le préfixe, le fichier est ignoré)
        MsgBox (FichierSource & " est ouvert"), vbOKOnly + vbInformation, "TestSiFichiersSourcesOuverts"
        MsgBox "Il faut fermer le fichier source ouvert !"
        GoTo Fin
    Else
        GoTo Suite1
    End If

'Fichier OOS Labo ouvert ?
Suite1:
FichierSource = ListeDesFichiersSource.Cells(3, 2).Value
MsgBox ("Test " & FichierSource & " est ouvert"), vbOKOnly + vbInformation, "TestSiFichiersSourcesOuverts"
    If IsFileOpen(Chemin & FichierSource) Then
        MsgBox "Il faut fermer le fichier source ouvert !"
        GoTo Fin
    Else
        GoTo Suite2
    End If

'Fichier Invalides Labo ouvert ?
Suite2:
FichierSource = ListeDesFichiersSource.Cells(4, 2).Value
MsgBox ("Test " & FichierSource & " est ouvert"), vbOKOnly + vbInformation, "TestSiFichiersSourcesOuverts"
    If IsFileOpen(Chemin & FichierSource) Then
        MsgBox (FichierSource & " est ouvert"), vbOKOnly + vbInformation, "TestSiFichiersSourcesOuverts"
        MsgBox "Il faut fermer le fichier source ouvert !"
        GoTo Fin
    Else
        ' appeler la procédure suivante, pour continuer
    End If

Application.ScreenUpdating = True

Fin:
End Sub

[unparia]

Bonjour
Imperfection de VBA lorsque le fichier est introuvable.
Type errnum as string et initialise-le ainsi dans ton code :

Code :

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

errnum = Trim(Err.Number)

et cela devrait mieux fonctionner

Ceci étant, existent des manières plus simples (utilisation de err.description)

PS : je remarque par ailleurs que tu n'as pas typé ta fonction.

E t dire qu'il te suffirait (avec ton code) :
1) de la typer en boolean
2) de définir ainsi ta variable errnum

Code :

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

errnum = Err.Number

pour que tout aille bien, sans rien modifier d'autre ...

Edit

Voilà ce que j'écrirais personnellement :

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
Function IsFileOpen(FichierSource As String) As Boolean
    Dim filenum As Integer
    On Error Resume Next
    filenum = FreeFile()
    Open FichierSource For Input Lock Read As #filenum
    Close filenum
    Select Case Err.Number
        Case 0
          ' IsFileOpen = False ' ne sert à rien
        Case 70
            IsFileOpen = True
        Case Else
            MsgBox Err.Number & vbCrLf & Err.Description
    End Select
    on error goto 0
End Function

[Marino69]

Bonjour unparia,

et tout d'abord un grand merci pour ton aide !

Je suis la piste de la solution plus simple (utilisation de err.description) et j'ai vu qu'il y a un tuto sur ce site pour la Gestion des erreurs :https://silkyroad.developpez.com/VBA/GestionErreurs/.
En attendant de l'assimiler j'ai tester les deux autres pistes suggérées, mais pour l'instant sans atteindre mon objectif.

- J'ai corrigé le code initial selon les recommandations, mais avec maladresse car j'avoue que je ne comprends pas tout à fait le fonctionnement de cette fonction que j'ai trouvée sur un forum.

Correction du code initial :
Fonction ../.. As Boolean
Dim errnum As String
Après "Close filenum : errnum = Trim(Err.Number)

Test 1 - Résultat : NonOK
Test : avec le fichier "fichier de suivi de lots 2019" ouvert
Résultat attendu : msgbox "fichier de suivi de lots 2019 est ouvert"
Résultat obtenu : Bug + même erreur que précédemment : "Erreur d'exécution 53 : Fichier introuvable"

Test 2 - J'ai également testé le code que tu préconises :

- pas de bug (c'est mieux !)
- Fonctionnement toujours OK sur les 2 fichiers non partagés
- mais, pour le fichier partagé, annonce dans une fenêtre msgbox : "53 Fichier introuvable", alors que ce fichier est bien là et ouvert

J'ai donc encore besoin d'un coup de pouce pour terminer cette étape !
As-tu une idée pour faire marcher le 2ème code ?

Merci encore pour ton aide,
Marino


Test 1 - Code initial corrigé

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
 
Function IsFileOpen(FichierSource As String) As Boolean
 
 
    Dim filenum As Integer
    Dim errnum As String
 
    On Error Resume Next
    filenum = FreeFile()
 
    Open FichierSource For Input Lock Read As #filenum
    Close filenum
    errnum = Trim(Err.Number)
    On Error GoTo 0
 
    Select Case errnum
 
        Case 0
         IsFileOpen = False
 
        Case 70
            IsFileOpen = True
 
        Case Else
            Error errnum  '--> Ligne surlignées en jaune lors de l'Erreur d'exécution 53 : Fichier introuvable
    End Select
End Function

Test 2 - Nouveau code proposé

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
 
Function IsFileOpen(FichierSource As String) As Boolean    
 
Dim filenum As Integer
    On Error Resume Next
    filenum = FreeFile()
 
    Open FichierSource For Input Lock Read As #filenum
    Close filenum
 
    Select Case Err.Number
 
        Case 0
         'IsFileOpen = False '--> ne sert à rien
 
        Case 70
            IsFileOpen = True
 
        Case Else
            MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly + vbInformation, "IsFileOpen"
 
    End Select
    On Error GoTo 0
 
End Function

[Marino69]

Re-bonjour Unparia,

Je corrige mon post précédent car j'avais fait les corrections de la fonction mais omis de retirer le préfixe [partagé] que j'avais ajouté au nom du fichier - donc normal que le fichier soit introuvable.
Pleine d'espoir, j'ai donc retesté le code Test 2.

Le résultat est identique à celui de mon projet de départ :
- cette macro ne reconnait pas le fichier partagé (elle l'ignore lorsqu'il est ouvert)
- elle reconnait bien les 2 autres

Je voulais aussi confirmer que c'est bien la caractéristique "fichier partagé" qui inhibe le test, car si je retire cette option du fichier, la macro fait son alerte correctement quand le fichier est ouvert.


Voici le code de la fonction et de la procédure, tel que testé

Cordialement,
Marino

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
 
Function IsFileOpen(FichierSource As String) As Boolean
 
    Dim filenum As Integer
    On Error Resume Next
    filenum = FreeFile()
 
    Open FichierSource For Input Lock Read As #filenum
    Close filenum
 
    Select Case Err.Number
 
        Case 0
         'IsFileOpen = False '--> ne sert à rien
 
        Case 70
            IsFileOpen = True
 
        Case Else
            MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly + vbInformation, "IsFileOpen"
 
    End Select
    On Error GoTo 0
 
End Function
 
 
Sub TestSiFichiersSourcesOuverts()
 
'Procédure pour tester si les fichiers sources sont déjà ouverts
'A appeler dans la procédure TesteSiFichierExiste
 
Application.ScreenUpdating = False
 
'Etape 1 : Déclarer le chemin d'accès, le nom du fichier Destinataire,le Workbook et la feuille où sont indiqués les noms des fichiers sources
Chemin = ThisWorkbook.Path & "\"
Set Destinataire = ThisWorkbook
Set ListeDesFichiersSource = Destinataire.Sheets("Nom Fichiers Sources")
 
'Etape 2 : Tester si les fichiers sources sont ouvert - Si ouverts : message et stop
 
'Fichier Suivi QP ouvert ?
FichierSource = ListeDesFichiersSource.Cells(2, 2).Value
MsgBox ("Test si " & FichierSource & " est ouvert"), vbOKOnly + vbInformation, "TestSiFichiersSourcesOuverts"
    If IsFileOpen(Chemin & FichierSource) Then
        MsgBox (FichierSource & " est ouvert"), vbOKOnly + vbInformation, "TestSiFichiersSourcesOuverts"
        MsgBox "Il faut fermer le fichier source ouvert !"
        GoTo Fin
    Else
        GoTo Suite1
    End If
 
'Fichier OOS Labo ouvert ?
Suite1:
FichierSource = ListeDesFichiersSource.Cells(3, 2).Value
MsgBox ("Test si " & FichierSource & " est ouvert"), vbOKOnly + vbInformation, "TestSiFichiersSourcesOuverts"
    If IsFileOpen(Chemin & FichierSource) Then
        MsgBox "Il faut fermer le fichier source ouvert !"
        GoTo Fin
    Else
        GoTo Suite2
    End If
 
'Fichier Invalides Labo ouvert ?
Suite2:
FichierSource = ListeDesFichiersSource.Cells(4, 2).Value
MsgBox ("Test si " & FichierSource & " est ouvert"), vbOKOnly + vbInformation, "TestSiFichiersSourcesOuverts"
    If IsFileOpen(Chemin & FichierSource) Then
        MsgBox (FichierSource & " est ouvert"), vbOKOnly + vbInformation, "TestSiFichiersSourcesOuverts"
        MsgBox "Il faut fermer le fichier source ouvert !"
        GoTo Fin
    Else
        ' appeler la procédure suivante, pour continuer
    End If
 
Application.ScreenUpdating = True
 
Fin:
End Sub

[unparia]

Je ne travaillepersonnellement jamais avec des fichiers partagés.
Toutefois --->>
Intéresse-toi à la propriété UserStatus d'un objet Workbook (rubrique Workbook.UserStatus, propriété de ton aide VBA interne).
Et à l'exemple accompagnant cette rubrique. Si ton fichier existe, ajoute-le (méthode Add) à ta collection Workbooks et regarde ce que te retourne ActiveWorkbook.UserStatus.

[Marino69]

Bonjour Unparia,

Je suis allée voir l'aide VBA rubrique "Workbook.UserStatus, propriété", mais je ne sais pas comment m'en servir ni dans quel objectif.

J'ai cheminé un petit peu indépendamment et mon analyse est la suivante (si ma compréhension de "Open (FichierSource) For Input Lock Read As #filenum" est correcte):

Je comprends que ce code a pour objectif de recueillir le numéro de l'erreur provoquée par "un essais d'ouverture du fichier, sans l'ouvrir vraiment".
Si le fichier est fermé : pas d'erreur --> test = False
L'essais d'ouverture d'un fichier "normal" déjà ouvert, provoque l'erreur 70 (=Permission refusée) --> test = True

Je suppose que ce concept n'est pas pertinent pour un fichier partagé, car un tel fichier, par définition, permet plusieurs ouvertures et du coup ne doit renvoyer aucune erreur dans ce test.

J'ai aussi essayé de remplacer le n° d'erreur 70 par 55 (=fichier ouvert)
- un fichier "normal" fait ouvrir la msg box indiquant Erreur 70
- pas d'effet sur le fichier partagé : il ne renvoi rien, ou est invisible

Voici donc une autre approche (piquée dans un forum), qui n'exploite pas de numéro d'erreur si ouverture, mais qui teste directement si le workbook existe (partant du principe qu'un workbook est un fichier ouvert).
- une fonction "Function BookOpen(FichierSource As String) As Boolean"
- appelée par un sub : If BookOpen(FichierSource) = True Then .../...

Ce n'est qu'une tentative ... car ne fonctionne pas encore :
'--> Erreur de compilation, type d'argument by ref incompatible

Que penses-tu de mon analyste concernant l'approche initiale ?
Pourrais-tu regarder ce qui cloche dans le nouveau code ci-dessous (nouvelle approche) ?

Encore tous mes remerciements,
Marino

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
Function BookOpen(FichierSource As String) As Boolean

    Dim oBk As Workbook
    On Error Resume Next
    
    On Error GoTo 0
    
    Set oBk = Workbooks(FichierSource)
    If oBk Is Nothing Then
        BookOpen = False
    Else
        BookOpen = True
    End If
    
End Function

Sub DeuxiemeTestSiFichiersSourcesOuverts()

'Procédure pour tester si les fichiers sources sont déjà ouverts
'A appeler dans la procédure TesteSiFichierExiste

Application.ScreenUpdating = False
 
'Etape 1 : Déclarer le chemin d'accès, le nom du fichier Destinataire,le Workbook et la feuille où sont indiqués les noms des fichiers sources
Chemin = ThisWorkbook.Path & "\"
Set Destinataire = ThisWorkbook
Set ListeDesFichiersSource = Destinataire.Sheets("Nom Fichiers Sources")

'Etape 2 : Tester si les fichiers sources sont ouvert - Si ouverts : message et stop

'Dim FichierSource As string déclaré en variable publique

'Fichier Suivi QP ouvert ?
FichierSource = ListeDesFichiersSource.Cells(2, 2).Value

MsgBox ("Test si " & FichierSource & " est ouvert"), vbOKOnly + vbInformation, "TestSiFichiersSourcesOuverts"

    If BookOpen(FichierSource) = True Then  '--> Erreur de compilation type d'argument by ref incompatible
        MsgBox FichierSource & " is open", vbOKOnly + vbInformation
        GoTo Fin
    Else
        MsgBox FichierSource & " is NOT open", vbOKOnly + vbExclamation
        GoTo Suite2
    End If
    

'Fichier OOS Labo ouvert ?
Suite1:
FichierSource = ListeDesFichiersSource.Cells(3, 2).Value

MsgBox ("Test si " & FichierSource & " est ouvert"), vbOKOnly + vbInformation, "TestSiFichiersSourcesOuverts"
    
    If BookOpen(FichierSource) = True Then
        MsgBox FichierSource & " is open", vbOKOnly + vbInformation
        GoTo Fin
    Else
        MsgBox FichierSource & " is NOT open", vbOKOnly + vbExclamation
        GoTo Suite2
    End If

   
'Fichier Invalides Labo ouvert ?
Suite2:
FichierSource = ListeDesFichiersSource.Cells(4, 2).Value

MsgBox ("Test si " & FichierSource & " est ouvert"), vbOKOnly + vbInformation, "TestSiFichiersSourcesOuverts"
    
    If BookOpen(FichierSource) = True Then
        MsgBox FichierSource & " is open", vbOKOnly + vbInformation
        GoTo Fin
    Else
        MsgBox FichierSource & " is NOT open", vbOKOnly + vbExclamation
        ' appeler la procédure suivante, pour continuer
    End If

Application.ScreenUpdating = True

Fin:
End Sub