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

[Foufoudora]

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

 

[sousou]

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

 

[nat54]

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

Bonjour,

Trouvée sur le net, pas testée

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

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

 

[Foufoudora]

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

 

[kiki95]

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

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