Vérification d'ouverture de fichier

Version imprimable

Bonjour à tous et à toutes !

Je me tourne vers vous car j'ai un problème, je vous explique mon fichier excel :
J'ai crée un fichier excel de gestion de stocks, et pour gérer tous les stocks de réactifs, je dois aller chercher des informations dans chaque fiches individuelles de réactifs. Pour cela j'ouvre les fichiers grâce à un code vba, je prends les infos et le referme.
Le problème étant que les fichiers portent le même nom, j'aimerais donc mettre une sécurité avant de commencer la manip qui permettrait de vérifier si un fichier de ce nom est ouvert, et si oui le fermer dans tout les cas.
J'ai trouvé il y a quelque temps une fonction qui permet de vérifier si un fichier est ouvert, la voici :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Function IsFileOpen(Filename As String) Dim filenum As Integer, Errnum As Integer On Error Resume Next filenum = FreeFile() Open Filename 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 End Select End Function
Je l'utilise donc pour ouvrir mon fichier ou je dois extraire les informations. Pour la sécurité j'ai écris ce code qui ne marche pas :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 'Sécurité If IsFileOpen("M:\Fiche de vie et de renseignement test.xlsm") Then Workbooks("M:\Fiche de vie et de renseignement test.xlsm").Close End If 'Ouverture du fichier, c'est ici que nous cherchons le fichier voulu avec un lien précis. If IsFileOpen("M:...\Fiche de vie et de renseignement test.xlsm") Then GoTo TrouveeNom_1 Else Workbooks.Open Filename:= _ "M:...\Fiche de vie et de renseignement test.xlsm" GoTo TrouveeNom_1 End If
Le code "Sécurité" ne ferme pas le fichier déjà ouvert.. Je ne comprends pas pourquoi car sans ce code, la deuxième partie fonctionne, ouvre le fichier désiré et la referme après.

Merci d'avance de votre aide :D

Edit : Je pense que le problème vient du code utilisé pour la sécurité, j'ai l'impression que le code ne détecte pas mon fichier ouvert, et continue le code comme si il ne lisait pas ces 3 lignes

28/11/2018, 09h52
MarcelG

Bonjour iZinoux, Bonjour le Forum,

Bienvenu,

Apparemment, les fichiers (classeurs) sont susceptibles d'être ouverts par d'autres utilisateurs.
Ils ne peuvent être fermés à distance.
Dans ce cas, 2 solutions
- les ouvrir en lecture seule
- dans ces classeurs, à l'évènement Open, déclaration de l'ouverture en lecture seule si l'identifiant n'est pas le tien

Pourrais-tu reporter le code
- dans son intégralité (TrouveeNom_1)
- en le balisant avec des bornes #
- s'il n'est pas effectif alors en précisant l'anomalie et la ligne surlignée en jaune qui entrîne le bug.

Bonjour, merci de votre réponse

En effet, les fichiers peuvent être ouverts par d'autres utilisateurs, je comptais me pencher sur ce problème après.
Pour l'instant j'aimerais fermer le fichier si celui ci est ouvert sur l'ordinateur en question.
Vous m'avez d'ailleurs fais remarquer que ce n'est pas si utile au final. Il n'y a qu'un seul utilisateur qui utilisera ce code, il n'aura qu'à vérifier si un fichier du même nom est ouvert.
Mais j'aimerais tout de même mettre une petite sécurité au début, fermant le fichier de ce nom, si ouvert.

Sinon voici le code dans son intégralité :

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
Sub Analyse()
    'DECLARATION DES VARIABLES
    Dim codeart As String
    Dim Stockr, Stockm, L As Integer
    Application.ScreenUpdating = False
    '****************************************************************************************************************
    '****************************************************************************************************************
    'OUVERTURE DU FICHIER BLEU DE BROMOPHENOL
    If IsFileOpen("M:\CQ\Techniciens\Réactifs achetés\Fiche de vie Réactifs achetés\Fiche de vie et de renseignement test.xlsm") Then
        Workbooks("M:\CQ\Techniciens\Réactifs achetés\Fiche de vie Réactifs achetés\Fiche de vie et de renseignement test.xlsm").Close
    End If
 
    If IsFileOpen("M:\CQ\Techniciens\Réactifs achetés\Fiche de vie Réactifs achetés\HPLC\CPL-Réf\CPL-Réf-Sec\CPL-Réf-Sec-Com\CPL-Ref-Sec-Com-Fri\CPL-Ref-Sec-Com-Fri-120 Ethylparabène\Fiche de vie et de renseignement test.xlsm") Then
        GoTo TrouveeNom_1
    Else
        Workbooks.Open Filename:= _
        "M:\CQ\Techniciens\Réactifs achetés\Fiche de vie Réactifs achetés\HPLC\CPL-Réf\CPL-Réf-Sec\CPL-Réf-Sec-Com\CPL-Ref-Sec-Com-Fri\CPL-Ref-Sec-Com-Fri-120 Ethylparabène\Fiche de vie et de renseignement test.xlsm"
        GoTo TrouveeNom_1
    End If
    'TROUVER LE REACTIF
TrouveeNom_1:
    codeart = Workbooks("Fiche de vie et de renseignement test").Sheets("Fiche de renseignement").Range("D3")
    For i = 8 To 900
    If Workbooks("Gestion des stocks").Sheets("Verif Stock Réactifs").Cells(i, 3) = codeart Then
    L = i
    End If
    Next i
    'TRANSFERT DES DONNEES
    Stockr = Workbooks("Fiche de vie et de renseignement test").Sheets("Fiche de vie").Range("N2").Value
    Stockm = Workbooks("Fiche de vie et de renseignement test").Sheets("Fiche de vie").Range("N3").Value
    Workbooks("Gestion des stocks").Sheets("Verif Stock Réactifs").Range("D" & L) = Stockm
    Workbooks("Gestion des stocks").Sheets("Verif Stock Réactifs").Range("E" & L) = Stockr
    Application.DisplayAlerts = False
    Workbooks("Fiche de vie et de renseignement test.xlsm").Close
End Sub

Je n'ai cependant aucune erreur avec les lignes 'Sécurité. Le code continue, mais rien ne se passe au niveau de ces lignes.
Merci

Bonjour,

Le problème vient du fait que pour fermer un classeur avec la méthode Close, il faut renseigner le nom du classeur avec son extension (Fichier.xlsm) et non son chemin complet.

Ci dessous tu trouveras une méthode pour récupérer le nom à partir du chemin.
Code:

1 2 3 4 5 6 7 8 9 10 11 Const sFilePath As String = "C:\Users\McEvee\Desktop\Developpez\Test.xlsx" 'Récupérer le nom du fichier à partir de son chemin Dim sFileName As String sFileName = VBA.Mid$(sFilePath1, VBA.InStrRev(sFilePath1, "\") + 1, VBA.Len(sFilePath1)) 'Sécurité If IsFileOpen(sFilePath) Then Workbooks(sFileName).Close End If
J'ai testé avec ta fonction (que je vais conservé car très utile comme test :D) et j'ai réussi à fermer le fichier qui était ouvert

En espérant avoir répondu a tes attentes.

A+

28/11/2018, 10h21
iZinoux

Bonjour John.

J'ai testé avec ton code, cela ne change rien. :?
Pourrais-tu m'expliquer un peu plus en détails les 2 premières lignes ? J'ai dû mal a les comprendre.

Merci.

Bonjour,

Précisément, les fichiers dont tu veux tester l'ouverture, à ce moment précis
- sont utilisés par d'autres utilisateurs (voir plus haut)
- ou bien sur ton poste?

S'ils sont ouverts sur ton poste, alors ru peux effectuer le test sur la collection Workbooks en utilisant le nom du classeur
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Option Explicit Sub test_open() Dim wkb As Workbook For Each wkb In Workbooks With wkb If .Name = "toto.xlsm" Then .Close SaveChanges:=False End With Next wkb End Sub

28/11/2018, 10h36
iZinoux

A ce moment précis je cherchais sur mon poste.
Ton code fonctionne très bien, merci !

Maintenant je vais me pencher sur le cas ou le fichier est ouvert par un autre utilisateur, mais je n'ai aucune idée de comment faire.
Un code existe-t-il pour ouvrir le fichier en lecture seule ? Et cela n'empêchera pas au code de récupérer les informations dans mon fichier ?

Merci.

Re,
Code:

1 2 3 4 5 Const sFileChemin As String = "M:...\Fiche de vie et de renseignement test.xlsm" Dim sFileName As String sFileName = VBA.Mid$(sFilePath1, VBA.InStrRev(sFilePath1, "\") + 1, VBA.Len(sFilePath1)) 'sFileName donne "Fiche de vie et de renseignement test.xlsm"
La premiere variable est le chemin complet et pour fermer un classeur ouvert dans une instance excel il faut utiliser son nom et non son chemin comme tu le fait sur la dernière ligne de ton code complet

Code:

Workbooks("Fiche de vie et de renseignement test.xlsm").Close

La variable FileName est une manière dynamique de récupérer "Fiche de vie et de renseignement test.xlsm" en partant de "M:...\Fiche de vie et de renseignement test.xlsm"
En vba la fonction Mid équivaut à STXT en excel, Len équivaut à NBCAR et InStrRev équivaut à CHERCHE en excel mais en commençant par la fin de la chaine de texte.

Pour tester si un classeur est déjà ouvert sur ton poste le code de MarcelG est bon.

Si tu veux testé si un autre utilisateur utilise ton fichier il y a moyen avec ce code
Code:

1 2 3 4 5 6 7 'Test si le fichier est déjà ouvert If Workbooks("Fiche de vie et de renseignement test.xlsm").ReadOnly Then Else End If
Et pour ouvrir un fichier en lecture seule il faut rajouter la propriété ReadOnly à la méthode Open
Code:

1 2 3 'Ouverture d'un fichier en lecture seule surtout si tu ne fait que de la copie de donnée Workbooks.Open Filename:="M:...\Fiche de vie et de renseignement test.xlsm", ReadOnly:=True
Si tu ne fait que de la copie de donnée pas de souci. Il faut que tu saches que tu auras accès à la dernière version enregistrée de l'utilisateur alors il peut y avoir des évolutions de saisies au moment de ta mise à jour.

Pour désactiver les messages d'erreur à l'ouverture d'un fichier tu peux utiliser la commande suivant :

Code:

Application.DisplayAlerts = False

28/11/2018, 10h45
iZinoux

Super, merci à vous deux !
J'ai testé tout fonctionne ! :)

Merci beaucoup

Salut,

Pour information, dans les classeurs en question, à l'évènement Open, tu peux inclure

Code:

1
2
3
4
5
6
7
8
9
10
With ThisWorkbook
         If .ReadOnly = False And Application.Username <> "tonusername" Then
               Application.DisplayAlerts = False  
                'Consirération d'une sauvegarde du classeur, l'enregistrement du classeur ne sera pas demandé       
               .Saved = True
                'Modifie le mode de lecture 
               .ChangeFileAccess Mode:=xlReadOnly
               Application.DisplayAlerts = True
         End If
End With

Pour connaître ton UserName

Dans la fenêtre Exécution (pour l'ouvrir : CTRL + G)
Tu codes

Code:

?Application.Username

(ne pas oublier "?")
puis touche "Enter"