VBA, Comment éviter qu'une macro accède a un fichier déjà ouvert
Le
Emile63
Bonjour à tous,
J'ai un modèle de classeur de type formulaire(xltm), qui au moment de sa =
fermeture (BeforeClose), enregistre un certain nombre de données contenue=
s dans ces cellules dans un autre classeur sous forme de base de données =
afin de garder un historique.
Malheureusement, travaillant à plusieurs personnes sur ce modèle, il ar=
rive que l'on accède simultanément au classeur d'historique, du coup le=
s données du dernier qui essaie d'y accéder ne son pas enregistrées c=
ar déjà ouvert.
Je souhaiterais donc ajouter un petit controle qui diffère l'ouverture de=
quelques secondes (5) par un timer le cas échéant, ou si le classeur e=
st toujours inaccessible après ce délai, un message qui indique un prob=
lème d'accès et la fermeture de la proc. en cours.
Ci dessous la partie en question de ma procédure:
' Procédure
Set Wk = Workbooks.Open(Répertoire & "" & Fichier)
'
' Ici, je souhaiterais mettre un contrôle au cas ou le classeur en questi=
on soit déjà ouvert
' par un timer de 5 secondes, et si toujours ouvert, un message d'alerte en=
fin de la procédure.
'
MonLien = CStr(Tableau_Données(18))
With Wk
With .Worksheets(Feuille)
DerLig = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & DerLig) = CDate(Tableau_Données(13)) 'Date
.Range("B" & DerLig) = CStr(Tableau_Données(9)) ' Test
.Range("C" & DerLig) = CStr(Tableau_Données(10)) ' Essai
.Hyperlinks.Add Anchor:=ActiveSheet.Range("R" & DerLig), Addr=
ess:=MonLien, TextToDisplay:=MonLien, ScreenTip:="Ouvrir fichier"
End With
'. Suite de la proc.
En vous remerciant d'avance pour votre aide et conseils,
Cordialement
Emile
J'ai un modèle de classeur de type formulaire(xltm), qui au moment de sa =
fermeture (BeforeClose), enregistre un certain nombre de données contenue=
s dans ces cellules dans un autre classeur sous forme de base de données =
afin de garder un historique.
Malheureusement, travaillant à plusieurs personnes sur ce modèle, il ar=
rive que l'on accède simultanément au classeur d'historique, du coup le=
s données du dernier qui essaie d'y accéder ne son pas enregistrées c=
ar déjà ouvert.
Je souhaiterais donc ajouter un petit controle qui diffère l'ouverture de=
quelques secondes (5) par un timer le cas échéant, ou si le classeur e=
st toujours inaccessible après ce délai, un message qui indique un prob=
lème d'accès et la fermeture de la proc. en cours.
Ci dessous la partie en question de ma procédure:
' Procédure
Set Wk = Workbooks.Open(Répertoire & "" & Fichier)
'
' Ici, je souhaiterais mettre un contrôle au cas ou le classeur en questi=
on soit déjà ouvert
' par un timer de 5 secondes, et si toujours ouvert, un message d'alerte en=
fin de la procédure.
'
MonLien = CStr(Tableau_Données(18))
With Wk
With .Worksheets(Feuille)
DerLig = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & DerLig) = CDate(Tableau_Données(13)) 'Date
.Range("B" & DerLig) = CStr(Tableau_Données(9)) ' Test
.Range("C" & DerLig) = CStr(Tableau_Données(10)) ' Essai
.Hyperlinks.Add Anchor:=ActiveSheet.Range("R" & DerLig), Addr=
ess:=MonLien, TextToDisplay:=MonLien, ScreenTip:="Ouvrir fichier"
End With
'. Suite de la proc.
En vous remerciant d'avance pour votre aide et conseils,
Cordialement
Emile
Une procédure qui parut sur ce site il y a for longtemps!
----------Début de copie----------
Moi j'ai un eu problème similaire en réseau NT avec Excel 2000.
Suite à l'aide de plusieurs sur ce forum (encore merci à El-Joker, Frédéric
Sigonneau et Thierry Rural, voir ficelle "Macro Workbooks.Open sur fichier
déjà en cours de lecture" du 10/12/2001 11:54) j'ai fini par réussir à faire
çà...
Pour ce genre de fichiers qui sont souvent ouverts (pas longtemps) par
d'autres utilisateurs, j'ai créé une interface d'ouverture (en fait un
personnal.xls dans le startup).
Cette interface (non hiden) contient les boutons d'ouverture directe des
fichiers en question.
Dans l'exemple le bouton d'ouverture de "Demand.xls" lance la macro
"CallDemands"
C'est radical! si le fichier est ouvert = Message (et il s'ouvre pas) sinon
il s'ouvre.
Voici le code : (à mettre dans un module standard du personnal.xls)
'--------------------------------------------------------
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
Case Else
Error errnum
End Select
End Function
'--------------------------------------------------------
Sub CallDemands()
Dim Msg, Style, Title
If IsFileOpen("P:DevelopmentsDemand.xls") Then
MsgBox "File Already in use" & Chr(13) & "Please Try Latter"
Else
Workbooks.Open "P:DevelopmentsDemand.xls"
End If
End Sub
'--------------------------------------------------------
Super de garder ces anciens codes :)
P.
Le 24-02-16 14:19, MichD a écrit :
Super de garder ces anciens codes :)
P.
Le 24-02-16 14:19, MichD a écrit :