Tester si un fichier est ouvert - Cas d'un fichier partagé

**Marino69** · 22/03/2019, 10h49

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** · 22/03/2019, 11h54

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** · 22/03/2019, 15h10

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** · 22/03/2019, 19h22

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** · 22/03/2019, 20h45

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** · 23/03/2019, 19h42

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

**patricktoulon** · 23/03/2019, 21h20

bonsoir

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
Sub test()
    chemin$ = "C:\Users\polux\DeskTop\ttttt.xlsx"
    Set Wb = Workbooks.Open(chemin)
    MsgBox fichierstatus(chemin)
Wb.Close
End Sub
'
'
Sub test2()
    chemin$ = "C:\Users\polux\DeskTop\ttttt.xlsx"
    Set app = CreateObject("excel.application")
    app.Workbooks.Open chemin
    MsgBox fichierstatus(chemin)
    app.Quit
End Sub
'
'
Function fichierstatus(FichierSource As String) As String
    Dim x&, N, Inst$, Wb
    N = Mid(FichierSource, InStrRev(FichierSource, "\") + 1)
    IsFileOpen = "libre"
    On Error Resume Next
    x = FreeFile()
    Open FichierSource For Input Lock Read As #x: Close x
     Select Case Err.Number
    Case 0: fichierstatus = "libre"
    Case 70: fichierstatus = "ouvert"
        Inst = vbCrLf & "mais pas dans l'instance de l'application de ce classeur"
      Set Wb = Application.Workbooks(N)
        For Each Wb In Workbooks
            If Wb.Name = N Then Inst = vbCrLf & "dans cette instance de l'application "
        Next
        fichierstatus = fichierstatus & Inst
    Case 53: fichierstatus = "introuvable"
    Case Else: MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly + vbInformation, "IsFileOpen"
    End Select
    On Error GoTo 0
End Function

**Marino69** · 24/03/2019, 20h56

Bonjour Patrick,

Et tout d'abord grand merci de t'intéresser à ma difficulté et pour le code que tu me proposes.
Mais je suis assez débutante, et j'ai bien du mal à comprendre son fonctionnement pour l'adapter.

Du coup je me permets de te poser quelques questions de décryptage :

Dans la Sub :
- à quoi set le $ de : chemin$

Dans la fonction
- quel est le type des variables : Dim x&, N, Inst$, Wb (As String?)
- à quoi sert le & de x&
- à quoi sert le $ de Inst$
- N = Mid(FichierSource, InStrRev(FichierSource, "\") + 1) :
Confirmes tu que cette ligne est là pour extraire le nom du fichier du chemin d'accès complet ?

Dans mon contexte
FichierSource est le nom du fichier sans son chemin d'accès (du coup confirmes tu que ce Mid n'est pas nécessaire dans mon cas ?).
le chemain est défini comme suit :
Dim CheminRepertoire As String
CheminRepertoire = ThisWorkbook.Path & "\" car le fichier de la macro et les fichiers source sont placés dans le même répertoire
Du coup si j'ai besoin d'indiquer tout l'accès, j'écris : Chemin & FichierSource

- à quoi sert le # de : As #x: Close x

En espérant ne pas trop mettre à l'épreuve ta patience...

Cordialement,
Marino

**patricktoulon** · 24/03/2019, 21h46

re

Dans la Sub :
- à quoi set le $ de : chemin$

Dans la fonction
- quel est le type des variables : Dim x&, N, Inst$, Wb (As String?)
- à quoi sert le & de x&
- à quoi sert le $ de Inst$
- N = Mid(FichierSource, InStrRev(FichierSource, "\") + 1) :
Confirmes tu que cette ligne est là pour extraire le nom du fichier du chemin d'accès complet ?

$=As string
#= As double
&= As long
%=As integer

oui je confirme pour N tu a tres bien compris: la fonction InstrRev se comporte comme son opposé "Instr" sauf que l'on part de la droitede la chaine a analyser

je dis droite et non la fin du texte car en fait j'utilise ici le premier argument il y en a un 2d pour determiner a partir DE ou on veux demarer la recherche

une petite demo va t'aider a comprendre

INSTRREV vs INSTR

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
Sub textx()
chaine = "ttt/aaa/zzz/aaa/iii"
x1 = InStrRev(chaine, "aaa")
x2 = InStrRev(chaine, "aaa", x1)
Message = " Avec INSTRREV " & vbCrLf
Message = Message & "la chaine ""aaa"" se trouve a partir du  " & x1 & "eme caractere"
Message = Message & vbCrLf & "mais elle se trouve aussi a partir du " & x2 & " caractere"
 
MsgBox Message
 
'la meme chose avec instr
x1 = InStr(1, chaine, "aaa")
x2 = InStr(x1 + Len("aaa"), chaine, "aaa")
Message = " Avec INSTR " & vbCrLf
Message = Message & "la chaine ""aaa"" se trouve a partir du  " & x1 & "eme caractere"
Message = Message & vbCrLf & "mais elle se trouve aussi a partir du " & x2 & " caractere"
MsgBox Message
End Sub

Si tu lis bien les messages tu verra que l'ordre des trouvé sont inverses

je parle pas du 3 eme argument qui est le type de comparaison

pour le "#" devant X pour l'input je me suis jamais posé la question je suppose que ca a voir avec la valeur(NUMERIQUE!!!) de x d'ailleurs en remplacant "#x" par cdbl(x) ou clng(x) ou abs(x) ca fonctionne et aussi x tout court aussi

en gros ca veut dire "pile poil X"
voila

**Marino69** · 25/03/2019, 09h25

Bonjour Patrick

Tes explications mon bien éclairée - j'ai adapté ton code à mon application (cf. code joint).
J'ai une errreur de "compilation, type d'argument byRef incompatible", qui survient :
- dans la sub
- au niveau de MsgBox fichierstatus(Chemin)

Les adaptations apportées sont les suivantes :
J'ai déclaré les variables de façon classique, selon les correspondances que tu as indiquées
Je n'ai pas utilisé N mais FichierSource à la place : fichier source est le libellé du fichier à tester, récupéré dans une cellule d'une feuille du fichier contenant la macro
J'ai remplacé Chemin par (CheminRepertoire & FichierSource) : CheminRepertoire étant le chemin d'accès complet au répertoire où se trouve le fichier source
J'ai déclaré Dim app As Object, car bug si non

Pourrais-tu regarder ce qui peut coincer ?
et aussi pourrais-tu m'indiquer ce qui fait que ce code peut reconnaitre un fichier partagé ouvert ?

Encore tous mes remerciements,
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
 
Function fichierstatus(FichierSource As String) As String
 
 
    Dim x As Long
    Dim Inst As String
    Dim Wb As Variant
    'Dim FichierSource As string : défini en variable publique
 
    'N = Mid(FichierSource, InStrRev(FichierSource, "\") + 1)   '--> =FichierSource
    '--> c'est pour extraire le nom du fichier de son chemin d'ecces complet
    '--> InStrRev teste si un texte contient une chaîne de caractères spécifiée
    ' et si oui, elle permet de savoir où cette chaîne se trouve dans le texte.
    'Cherche à partir de la fin de la chaine - renvoie un chiffre (long)
    'correspond à la position depuis le début de la chaine
    '--> Mid extrait le texte d'une chaine situé à droite d'un point de départ : MID( text, start_position, [number_of_characters] )
    'Si le nb de caractère à extraire n'est pas spécifié : prend tous ceq qui est après le point de départ
 
    IsFileOpen = "libre"
    On Error Resume Next  '--> Cela inhibe les alertes pour debogage, si bugs
    x = FreeFile()
    Open FichierSource For Input Lock Read As #x: Close x  '--> # devant le x : à qui cela sert il ?
 
    Select Case Err.Number
        Case 0: fichierstatus = "libre"
        Case 70: fichierstatus = "ouvert"
            Inst = vbCrLf & "mais pas dans l'instance de l'application de ce classeur"  '--> vbCrLf : c'est pour passer à la ligne
        Set Wb = Application.Workbooks(FichierSource)   '--> N remplacé par FichierSource
        For Each Wb In Workbooks
            If Wb.Name = FichierSource Then Inst = vbCrLf & "dans cette instance de l'application "   '---> N remplacé par FichierSource
        Next
        fichierstatus = fichierstatus & Inst
    Case 53: fichierstatus = "introuvable"
    Case Else: MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly + vbInformation, "IsFileOpen"
    End Select
    On Error GoTo 0
End Function
 
 
Sub test2()
 
'Procédure pour tester si les fichiers sources sont déjà ouverts
'A appeler dans la procédure TesteSiFichierExiste
 
Application.ScreenUpdating = False
Dim CheminRepertoire As String
'Dim FichierSource As String : défini en variable publique
 
'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
CheminRepertoire = 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
'--> Cette cellule contient le nom du fichier partagé - libellé : "fichier de suivi de lots 2019.xlsx"
 
Dim app As Object  '--> déclaration car bug si non
'Dim Chemin As string : défini en variable publique
 
    Chemin = (CheminRepertoire & FichierSource)    'remplace : Chemin = "C:\Users\polux\DeskTop\ttttt.xlsx"
    Set app = CreateObject("excel.application")
    app.Workbooks.Open Chemin
    MsgBox fichierstatus(Chemin)   '--> erreur de compilatiohn , type d'argument byRef incompatible
    app.Quit
 
End Sub

**patricktoulon** · 25/03/2019, 11h41

re
ben oui la bonne blague
a quel momment tu dim chemin ????????
dim chemin as string ou dim chemin$

la fonction status attend un string et non un variant/string

petite demo regarde bien les deux sub quasi identique un a chemin dimé l'autre non tu vois tout dans la fentre des variable locales en bloquant la ligne x pour garder l'affichage
Nom : demo3.gif
Affichages : 1211
Taille : 414,7 Ko

Nom : demo3.gif
Affichages : 1211
Taille : 414,7 Ko

**Marino69** · 25/03/2019, 14h58

Bonjour Patrick,

Dim Chemin As string est bien défini, mais en variable publique
Dim FichierSource As string, également.
(Sorry je ne l'avait pas précisé dans le texte, mais l'avais seulement mentionné en commentaire dans le code)
Dim FichierSource As string est défini localement, au niveau de la sub

Du coup la fonction status a bien son "string"
avec Chemin = (CheminRepertoire & FichierSource),
MsgBox fichierstatus(Chemin) provoque quand même l'erreur de compilation , type d'argument byRef incompatible

Cordialement,
Marino

**patricktoulon** · 25/03/2019, 15h10

re
byval chemin as string dans la parenthèse

**Marino69** · 26/03/2019, 09h20

Bonjour Patrick,

La fonction s'intitule maintenant : Function fichierstatus(ByVal Chemin As String) As String
Effet positif : disparition de l'erreur de compilatiohn : "type d'argument byRef incompatible"

En revanche :
la durée d'exécution de la Sub est assez long
puis une autre erreur s'affiche:
- à la 1ère Ligne de la fonction, : IsFileOpen = "libre"
- Erreur de compilation : "Un appel de fonction dans la partie gauche de l'affectation doit renvoyer Variant ou Object"

... C'est pas gagné !

Une idée ? (... moi je suis hors de mon périmètre de connaissance !)

Cordialement,
Marino

**patricktoulon** · 26/03/2019, 14h05

re
ben c'est normal isfileopen n'est pas dimé et en plus ca te sert a rien la fonction te renvoie le statut du fichier

je comprends pas pourquoi tu a modifié ma fonction elle fonctionne très bien tu n'avais que le nom de fichier a adapter

**patricktoulon** · 26/03/2019, 14h10

ecoute
il y aurais une autre solution

a l'ouverture incrire user et dateheure puis save direct et pareil en fermeture(utilisation de 2 cellules )

celui qui l'ouvre en même temps dans l'open on contrôle ces deux cellules et basta

**Marino69** · 27/03/2019, 09h51

Bonjour Patrick,

Après revue attentive du code j'ai en effet repéré une erreur de ma part (code ci-dessous)
Maintenant la macro renvoie les messages des msgbox et ne bug plus.

En revanche, les messages renvoyés ne correspondent pas à la réalité :
Voici le comportement de la macro:

- Pour un fichier "normal" (non partagé) :
Si le fichier est fermé ---> Renvoie "Ouvert - mais pas dans l'instance de l'application de ce classeur"
Si le fichier est ouvert ---> Renvoie "Ouvert - dans cette instance de l'application"

- Pour le fichier partagé :
Si le fichier est fermé ---> Renvoie "libre"
Si le fichier est ouvert ---> Renvoie "libre"
--> ne reconnait pas un fichier partagé ouvert

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
 
Function fichierstatus(ByVal Chemin As String) As String
 
    Dim x As Long
    Dim Inst As String
    Dim Wb As Variant
    'Dim FichierSource As string : défini en variable publique
    Dim IsFileOpen As String
 
    'N = Mid(FichierSource, InStrRev(FichierSource, "\") + 1)   '--> =FichierSource
    '--> c'est pour extraire le nom du fichier de son chemin d'ecces complet
    '--> InStrRev teste si un texte contient une chaîne de caractères spécifiée
    ' et si oui, elle permet de savoir où cette chaîne se trouve dans le texte.
    'Cherche à partir de la fin de la chaine - renvoie un chiffre (long)
    'correspond à la position depuis le début de la chaine
    '--> Mid extrait le texte d'une chaine situé à droite d'un point de départ : MID( text, start_position, [number_of_characters] )
    'Si le nb de caractère à extraire n'est pas spécifié : prend tous ceq qui est après le point de départ
 
    IsFileOpen = "libre"
    On Error Resume Next  '--> Cela inhibe les alertes pour debogage, si bugs
    x = FreeFile()
    Open Chemin For Input Lock Read As #x: Close x  '--> # devant le x : à qui cela sert il ?
 
    Select Case Err.Number
        Case 0: fichierstatus = "libre"
        Case 70: fichierstatus = "ouvert"
            Inst = vbCrLf & "mais pas dans l'instance de l'application de ce classeur"  '--> vbCrLf : c'est pour passer à la ligne
        Set Wb = Application.Workbooks(FichierSource)   '--> N remplacé par FichierSource
        For Each Wb In Workbooks
            If Wb.Name = FichierSource Then Inst = vbCrLf & "dans cette instance de l'application "   '---> N remplacé par FichierSource
        Next
        fichierstatus = fichierstatus & Inst
    Case 53: fichierstatus = "introuvable"
    Case Else: MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly + vbInformation, "IsFileOpen"
    End Select
    On Error GoTo 0
End Function
 
Sub test2()
 
'Procédure pour tester si les fichiers sources sont déjà ouverts
'A appeler dans la procédure TesteSiFichierExiste
 
Application.ScreenUpdating = False
Dim CheminRepertoire As String
'Dim FichierSource As String : défini en variable publique
 
'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
CheminRepertoire = 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
'--> Cette cellule contient le nom du fichier partagé - libellé : "fichier de suivi de lots 2019.xlsx"
 
Dim app As Object  '--> déclaration car bug si non
'Dim Chemin As string : défini en variable publique
 
    Chemin = (CheminRepertoire & FichierSource)    'remplace : Chemin = "C:\Users\polux\DeskTop\ttttt.xlsx"
    Set app = CreateObject("excel.application")
    app.Workbooks.Open Chemin
 
 
    MsgBox fichierstatus(Chemin), vbOKOnly + vbInformation, "test2"    '--> erreur de compilatiohn , type d'argument byRef incompatible
    app.Quit
 
End Sub

**patricktoulon** · 27/03/2019, 10h18

prends un fichier vierge
met lui ca
enregistre le
partage le
et teste l'ouverture par deux utilisateur différents

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
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.DisplayAlerts = False
    With Sheets(1).Cells(Rows.Count, Columns.Count)
        If .Value = Environ("username") Then .Value = "": ThisWorkbook.Save
    End With
End Sub
Private Sub Workbook_Open()
    Application.DisplayAlerts = False
    With Sheets(1).Cells(Rows.Count, Columns.Count)
        If .Value <> Environ("username") Then
            MsgBox "le fichier est deja ouvert"
        Else
            .Value = Environ("username"): ThisWorkbook.Save
        End If
    End With
End Sub
Sub test()
    Sheets(1).Cells(Rows.Count, Columns.Count) = ""
End Sub

**Marino69** · 27/03/2019, 11h39

Bonjour Patrick,

C'est fait
Aucun message ne s'affiche lors de la 2eme ouverture du fichier

Marino

**eriiic** · 27/03/2019, 14h02

Bonjour à tous,

Je suppose que tu veux le savoir sans à avoir à ouvrir ce fichier (fichier lourd ?)
Tu pourrais te faire un fichier texte avec juste une valeur que tu incrémentes à l'ouverture, et que tu décrémentes à la fermeture.
Une lecture de ce petit fichier te dira combien d'utilisateurs actifs à ce moment.

S'il est léger autant l'ouvrir pour savoir.
eric

Tester si un fichier est ouvert - Cas d'un fichier partagé

Macros et VBA Excel

Discussions similaires

Partager

Partager