Savoir si Excel est déjà ouvertRésolu

Question

Bonjour, 
je suis en train d'optimiser une macro en rapport avec Excel. Il faudrait que l'application Excel soit fermé avant que je commence mes manipulations.
Auriez vous une solution pour éviter de demander à l'utilisateur de fermer ses pages Excel?

merci d'avance

NikatorS · Accepted Answer

La même chose en plus succin.

Function Test_EstOuvert(ByVal Fichier As String) As Boolean
    Dim FileNum As Long, TheError As Long
   
    FileNum = FreeFile()
    On Error Resume Next
    Open Fichier For Input Lock Read As #FileNum
    Close FileNum
    TheError = Err
    On Error GoTo 0
    If TheError = 70 Then
        Test_EstOuvert = True
    Else
        Test_EstOuvert = False
    End If
End Function

S Nikator

NHenry · Answer

Bonjour,

je pense que ça répondra à ta question :
Application.displayAlert=False
...
Application.displayAlert=True

CerberusPau · Answer

Bonjour iPol

Pourrais-tu préciser ton problème s'il te plaît :
Tu veux ouvrir un fichier Excel qui serait déjà ouvert et qu'il faudrait donc fermer  ? ou veux-tu qu'un utilisateur ne puisse ouvrir ton fichier que si Excel est fermé ?


Rataxes64

cs_iPol · Answer

Pour répondre à Rataxes64:

>Bonjour iPol
>
>Pourrais-tu préciser ton problème s'il te plaît :
>Tu veux ouvrir un fichier Excel qui serait déjà ouvert et qu'il >faudrait donc fermer ? ou veux-tu qu'un utilisateur ne puisse >ouvrir ton fichier que si Excel est fermé ?
>
>
>Rataxes64

Je compte utiliser un fichier Excel que l'utilisateur va sélectionner. Mais je voudrais être sur que ce fichier n'est pas déjà ouvert. Sinon ça pause des problèmes au niveau de l'enregistrement...

voila ci c'est pas assez précis redemandez moi.

Merci

CerberusPau · Answer

1) Quand on veut ouvrir (manuellement ou par macro) un fichier Excel déjà ouvert, et non partagé, Excel renvoie un avertissement (Fermer, Avertir, Ouvrir en lecture seule): Les macros n'aiment pas ça...

2) En mode partagé, c'est à la fermeture qu'il pourra être demandé de valider une modification aux utilisateurs connectés... 
C'est en général là que les problèmes se posent et que bien des utilisateurs ne savent pas vraiment quoi faire : Raison pour laquelle l'utilisation en mode partagé n'est pas du tout recommandée.

3) Il y a (au moins) deux métodes pour "avertir" que le fichier source qu'on veut ouvrir l'est déjà sans proposer l'avertissement par défaut d'Excel :
= > 3a) Si l'appel est fait par une macro, elle analyse l'ouverture existante par API, renvoie éventuellement un msgBox, et ferme l'appel.
= > 3b) Si l'appel se  fait par un raccourci pointant sur le fichier source, on crée un fichier Excel "tampon" qui comportera une macro comme au 3a) : Le raccourci pointera sur ce fichier d'appel et non plus sur le fichier source
Je te propose le code ci-dessous à inclure dans un   fichier d'appel   (Excel) de ton fichier

Dans ThisWorkbook


Private Sub Workbook_Open()                         'A l'ouverture...
MonExcelOpened


Dans un module

Private Declare Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long 'Fonction d'appel d'un répertoire
'************************************************************************************

Sub MonExcelOpened() 'Vérifie si le classeur Text.xls est déjà ouvert
Dim Chemin As String
Chemin   = "chemin de mon fichier"
SetUNCPath Chemin 'appelle la recherche du chemin valide par SetUNCPath
End Sub
'************************************************************************************

Sub SetUNCPath(Path As String) 'Recherche sur l'état de monficier Excel
Dim Chemin, Monfichier As String
Chemin = "chemin de mon fichier"
Monfichier = "nom de mon fichier"
Dim Status As Long
Status = SetCurrentDirectoryA(Path)                         'renvoie une valeur fonction de la réponse à la rcherche du chemin
Dim filenum As Integer, errnum As Integer
Set fso = CreateObject("Scripting.FileSystemObject")        'instancie l'API fso
If Status = 0 Then                                          'le chemin est valide
    If (fso.FileExists(Chemin & Monfichier)) = False Then   'le chemin esxiste mais pas le fichier...
        MsgBox " Désolé, Le fichier n'existe pas   ", vbCritical, "Application absente !"
        ThisWorkbook.Close savechanges:=False               'Fermeture du fichier d'appel
    Else                                                    'le chemin et le fichier existent
        On Error Resume Next                                'En cas d'erreur, passer à la recherche d'erreur suivante
        filenum = FreeFile()                                'Obtenir un numéro de Fichier de Test.
        Open Chemin & Monfichier For Input Lock Read As #filenum 'tente d'ouvrir le fichier et de le verrouiller
        Close filenum                                       'Ferme le fichier de Test
        errnum = Err                                        'Reprend le N° d'erreur trouvé
        On Error GoTo 0                                     'Relance la boucle de recherche d'erreur
        If errnum = 0 Then                                  'Pas d'erreur reconnue: le Programme peut être ouvert !
            Workbooks.Open Chemin & Monfichier              'Appelle l'ouverture du Programme
            ThisWorkbook.Close savechanges:=False           'Fermeture du fichier d'appel
        ElseIf errnum = 70 And User <> "" Then              'l'erreur N° 70 a été rencontrée: le programme est déjà ouvert par un autre utilisateur...
            MsgBox "Vous ne pouvez pas lancer le Programme." & vbCrLf & _
                "Un autre utilisateur est déjà connecté." _
                , vbCritical, "Utilisateur déjà connecté..." 'Message avec le NOM Prénom (téléphone) de l'uitilisateur connecté
            ThisWorkbook.Close savechanges:=False           'Fermeture du fichier d'appel
        Else                                                'Une erreur inattendue s'est produite...!
            MsgBox "            Erreur Inattendue N° " & errnum & vbCrLf & _
                "      Le Programme est inaccessible." & vbCrLf & _
                "Vérifiez vos paramètres de connexion.   ", vbCritical, "Erreur Critique" 'Message renvoyant le N° de l'erreur
            ThisWorkbook.Close savechanges:=False           'Fermeture du fichier d'appel
        End If
    End If
End Sub

Si dans le fichier d'appel tu inclues une liste des utilisateurs et de leurs coordonnées, tu peux retourner dans un MsgBox l'information du QUI est connecté et COMMENT le joindre. 
C'est ce que j'ai fait pour une gestion Excel de fichiers des sauvegardes de programmation d'automates entretenus par 40 techniciens sans m'encombrer d'une base de données.
En espérant que ça t'aidera.

  Cdt
Rataxes64

CerberusPau · Answer

Oups ! 
Il y a une erreur !
Voici la correction :
il faut supprimer And User <> ""  à la ligne 42

ElseIf errnum = 70 Then


Cdt
Rataxes64

CerberusPau · Answer

Ouaaahhhh!!

J'ai de la route à faire...
Merci infiniment!
Evidemment, je supose qu'il faut poser :

Fichier = "monchemin\monfichier"


Je sais que ça n'a rien à voir avec le post, mais comment inclue-t'on un lien dans un post ?
Merci

cdt
Rataxes64

NikatorS · Answer

Oui, c'est ça tu as tout compris. On l'utilise comme ça :
If Test_EstOuvert("monchemin\monfichier") = True Then
    MsgBox("monchemin\monfichier est ouvert")
End If

Ou bien comme ça :
If Test_EstOuvert("monchemin\monfichier") = False Then
    MsgBox("monchemin\monfichier n'est pas ouvert")
End If

Ou encore :
If Test_EstOuvert("monchemin\monfichier") = True Then
    MsgBox("monchemin\monfichier est ouvert")
Else
    MsgBox("monchemin\monfichier n'est pas ouvert")
End If

__________________________________________________

Pour inclure un lien tu cliques sur la chaine à gauche des trois ronds (jaune, bleu et rouge) ou bien au clavier sur Ctrl+L.



Ps: si les réponses te conviennent penses à cliquer sur le bouton "Réponse accepté"

S Nikator

CerberusPau · Answer

Merci,

J'avais déjà vu cette "chaîne", mais pas pu l'utiliser  : la faute à un mauvais paramétrage sur mon PC. C'est réglé.

Quand à "Réponse Acceptée", ben ça concernerait plutôt iPol qui est l'initiateur du Post et qui n'a pas encoré indiqué si cette solution lui convenait.

Cdt
Rataxes64

cs_iPol · Answer

OOOOOhhh 

c'est super génial merci 

moi aussi j'ai encore pas mal de chose à apprendre décidement.
Il est tout court en plus ce code 

Mon stage va être réussi avec des trucks comme ça.

Génial, merci à tous le monde pour l'aide

cs_iPol · Answer

... En faite, ce fichier j'aimerai le fermer si il est ouvert.

Et j'ai essayé différents code mais ça ne fonctionne pas.

encore un peu d'aide svp...

NikatorS · Answer

Si tu es le seul l'utiliser sur ton propre poste, il y a le bon vieuxWorkbook("MonFichier.xls").Close()
Mais je suppose que tu es en réseau et avec plusieurs utilisateurs et il n'y a pas de solution "propre" pour faire ça. 
A la limite, tu peux créer un timer pour tester la présence d'un autre fichier (appelons le "fermermoi.txt"). Dès que "fermermoi.txt" apparait sur le réseau, "MonFichier.xls" sait qu'il doit se fermer.


S Nikator

Ps: si les précédentes réponses te conviennent penses à cliquer sur le bouton "Réponse accepté". Je continuerai à te répondre quoi qu'il en soit.

NikatorS · Answer

Et voici comment faire un timer 

Dans un module tu met

Public TimerOn As Boolean

Private Sub OnTimer()
'Ici mon code qui s'exécute toutes les X secondes.
End Sub

Public Sub Timer()
    If TimerOn Then
        OnTimer
        'Application.OnTime TimeSerial(Hour(Time), Minute(Time), Second(Time) + 1), "timer", False 'Pour une seconde
        Application.OnTime TimeSerial(Hour(Time), Minute(Time), Second(Time) + 5), "timer", False 'Pour cinq secondes
    End If
End Sub


Pour activer le timer 

    TimerOn = True
    Timer


Pour désactiver le timer 

    TimerOn = False

S Nikator

CerberusPau · Answer

Bonne idée de S Nikator, 
Personnellement, j'ai mis en oeuvre une autre solution qui donne satisfaction à mes utilisateurs, certes au prix d'un script "lourd".

1°) Le raccourci pour ouvrir le fichier source au réseau ne pointe pas dessus, mais sur un fichier de lancement (Start.xls par exemple) qui analyse si le fichier source est ouvert ou non, avant de l'ouvrir.

2°) Le fichier source dispose d'un timer qui le ferme automatiquement en cas d'inactivité (le timer est relancé à chaque frappe) ; un message de fin de comptage des 10 dernières secondes s'affiche en premier plan, donnant le décompte et un beep à chaque secondes.
Si iPol est intéressé...
 
Pour le 1)ici.

Pour le 2)là.

(Scripts avec les références "de base" pour Excel 2003)

 Mais, je suis sûr que S Nikator pourra proposer de faire BEAUCOUP plus simple !

Cdt
Rataxes64

cs_iPol · Answer

OK 

Mais,

Je ne suis pas en réseau les utilisateurs se passerons le prgm et le fichier à utilisé et un fichier .xls qui et crée par l'utilisateur si il en a pas ou qu'il va choisir lui même si il en a déjà crée un. 

De plus, je ne peux pas utiliser de timer... j'ai essayé d'utiliser des composants et Visual Studio plante et il se ferme.

Il y a peut être moyen de simplifier ton code?

merci pour l'aide

cs_iPol · Answer

Désolé, je n'avais pas vu le :
Workbook("MonFichier.xls").Close()

qui devrait p-e suffire.
J'essayerai demain. J'avais essayé de plusieur façon mais pas avec celle ci

(c'est bête quand c'est juste une question de "vocabulaire")

Mais j'en profite pour poser une autre question:

je dois déplacer une "Picture" dans son contenant de 120000pxl (~sa taille)
du coup:

Pictur2.Left = 120000 sauf que au début c'est égale à 0

et à 32000 il m'annonce dépassement de capacité... il y a moyen de faire quelque chose? sachant que mon image est une genre de frise (donc pas haute mais longue) un changement d'échelle de celle-ci n'est pas une bonne solution.

NikatorS · Answer

Merci CerberusPau/Rataxes64.

Voici juste une petite modif pour 1)
'Dans This workbook
Private Sub Workbook_Open()
Test_XlsOuvert ("Chemin\NomFichierTesté")
end sub

'Dans un module
Public Sub Test_XlsOuvert(ByVal Fichier As String)
'... on garde le code
End Sub 
J'ai juste transformer la "Function" en "Sub" puisqu'on ne retourne rien et j'ai appelé directement la fonction sans passer par une sous fonction.

L'idée du 2) me plait beaucoup et le code est nikel. On peux toujours simplifier mais après c'est chipoter. Genre :
Sub Relancer()
'=> Arrêt du processus automatique de fermeture et relance
StopAutoClose
StartTempo                                      'engage la relance
End Sub Ça évite un doublon de code


S Nikator

NikatorS · Answer

iPol qu'entends-tu par "déplacer". Tu bouge l'image dans le PicturBox ou tu bouge le PictureBox sur la UserForm ?

Et pour ton dépassement de capa, une seul solution : découper ton image en plusieurs petites.
S Nikator

NikatorS · Answer

Autre chose j'ai fait une faute, c'est "WorkBooks" et pas "WorkBook"

S Nikator

CerberusPau · Answer

iPol : J'ai un peu de mal à comprendre si tu as ta solution concernat ton problème initial.
Pour le second, merci de m'autoriser de te suggérer de lancer un autre post.

S Nikator : Merci de tes remarques constructives , en espérant que cela fera avancer iPol dans son projet. Pour info, la macro est en fait beaucoup plus vaste et beaucoup d'autres appels ont été supprimés dans la Source postée (effectivement on peut se passer de Function). Elle gère aussi la création d'un fichier Texte à la fermeture, dont je reprend les infos de l'utilisateur connecté au fichier source (nom et coordonnées) afin de pouvoir les communiquer à ceux qui vellent se connecter alors que le fichier est ouvert.
Si j'ai un peu de temps, je posterai cette AddOn.

Cdt
Rataxes64

Savoir si Excel est déjà ouvert

23 réponses

Votre réponse

Discussions similaires