Macro pour Vérifier si Fichier XLS est déjà ouvert

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Foufoudora

XLDnaute Occasionnel
Bonjour à tous et à toutes,

Est ce possible de Vérifier si fichier xls est ouvert par un autre utilisateur
et si possible de lui envoyer un message de fermer le fichier ou de le forcer à le fermer après enregistrement ?

Je ne crois pas au père Noêl mais en vous !!!!!

Merci par Avance

Foufoudora
 
Re : Macro pour Vérifier si Fichier XLS est déjà ouvert

Bonjour

Interressante question!
pas sur que cela t'aide, mais c'est à creuser.

Principe:
Les fichiers doivent avopir été enregistré en mode partagé
c'est bout de procédure permette à l'ouverture du fichier de voir qui les à ouverts, mais tout cela dépent beucoup de la structure réseau!

Dim chemin, fichier

' Test d'ouverture d'un fichier ouvert en fichier partagé'
'Ce fichier doit avoir été enrtegistré avec la méthode saveas accessmode=xlshare


Sub deb()
chemin = "c:\"
fichier = "fichier.xls"
Workbooks.Open (chemin & fichier)
MsgBox ActiveWorkbook.MultiUserEditing
utilisateurs = ActiveWorkbook.UserStatus
For n = 1 To UBound(utilisateurs, 1)
MsgBox utilisateurs(n, 1) 'affichage du nom des noms pc
Next

End Sub

'enregistrement d 'un fichier en mode partagé
Sub enr()
ActiveWorkbook.SaveAs Filename:=chemin & fichier, accessmode:=xlShared
 
Re : Macro pour Vérifier si Fichier XLS est déjà ouvert

Bonjour,

Trouvée sur le net, pas testée

Code:
Vérifier si un classeur est ouvert. 
Comment vérifier si un classeur simplex.xls est ouvert et l'ouvrir si ce n'est pas le cas ? Sub OuvreSiPasOuvert()
' activer le fichier ==> sinon l'ouvrir
On Error Resume Next
Workbooks("simplex.xls").Activate
If Err <> 0 Then
fichier = "c:MesCacouillousSosMpfesimplex.xls"
Workbooks.Open Filename:=fichier
If Err <> 0 Then
MsgBox "Le fichier '" & fichier & "' est introuvable"
End If
End If
End Sub

Tu peux aussi remplacer Windows("simplex.xls").Activate par n=
Windows("simplex.xls").Width si tu veux pas activer la fenêtre

Si ça t'arrive souvent de chercher à savoir si tel ou tel classeur est déjà
ouvert ou non, pourquoi pas une petite fonction dans un coin de ton perso.xls :

Function IsOpen(Classeur$) As Boolean
On Error Resume Next
IsOpen = Not Workbooks(Classeur) Is Nothing
Err.Clear
End Function

Ensuite, dans ton code :

If not IsOpen("Simplex.xls") Then etc.
Frédéric Sigonneau, (N°700)

ou une autre macro

Code:
Sub TestFileOpened()

    ' Test to see if the file is open.
    If IsFileOpen("c:\Book2.xls") Then
        ' Display a message stating the file in use.
        MsgBox "File already in use!"
        '
        ' Add code here to handle case where file is open by another
        ' user.
        '
    Else
        ' Display a message stating the file is not in use.
        MsgBox "File not in use!"
        ' Open the file in Microsoft Excel.
        Workbooks.Open "c:\Book2.xls"
        '
        ' Add code here to handle case where file is NOT open by another
        ' user.
        '
    End If

End Sub

' This function checks to see if a file is open or not. If the file is
' already open, it returns True. If the file is not open, it returns
' False. Otherwise, a run-time error occurs because there is
' some other problem accessing the file.

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.

    ' Check to see which error occurred.
    Select Case errnum

        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
         IsFileOpen = False

        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = True

        ' Another error occurred.
        Case Else
            Error errnum
    End Select

End Function
 
Re : Macro pour Vérifier si Fichier XLS est déjà ouvert

Salut à tous

Excusez-moi de ne pouvoir répondre avant maintenant.

Waoooh, c'est quoi ce charabia.

j'ai essayé de l'intégrer dans un module mais aucun fonctionné car il manquait de déclaration de variable.
merci de me détailler la macro de A-Z.

Cordialement

Foufoudora
 
Re : Macro pour Vérifier si Fichier XLS est déjà ouvert

Une autre astuce est de mettre les utilisateurs dans un message.
Aide Microsoft Workbook.UserStatus, propriété
Cette propriété renvoie un tableau à deux dimensions partant de 1 et qui fournit des informations sur chaque utilisateur ayant ouvert le classeur en tant que liste partagée. Type de données Variant en lecture seule.

Le Compteur Utilisateur permet de connaitre le nombre

Code:
Function UtilisateurFichierPartagé(Classeur)
'Recherche des utilisateurs du fichier partagé

Dim HeureDébut As Date
CptUtilisateur = 0
MessageDiffusé = ""
    Users = ActiveWorkbook.UserStatus
'Boucle pour savoir le nom et le début du partage
    For Row = 1 To UBound(Users, 1)
        Utilisateur = Users(Row, 1)
        HeureDébut = Users(Row, 2)
        CptUtilisateur = CptUtilisateur + 1
        MessageIntro = "Le fichier est utilisé par "
        If Utilisateur <> Application.UserName Then
            MessageDiffusé = MessageDiffusé + Chr(10) + Utilisateur & " depuis le " & HeureDébut
        End If
    Next
        Message = MsgBox(MessageIntro & MessageDiffusé, , "Fichier " & Classeur & " utilisé")
End Function
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
10
Affichages
415
Réponses
2
Affichages
244
  • Question Question
Microsoft 365 Remplissage auto
Réponses
14
Affichages
390
Réponses
3
Affichages
475
Réponses
4
Affichages
324
Retour