refuser l'ouverture d'un classeur deja ouvert

[David590]

Bonsoir à tous,

J'ai 2 pc qui utilisent un classeur partagé et j'utilise le code ci dessous pour ne laisser l’accès qu'a un utilisateur à la fois

Workbooks.Open CheminDossier & "Partagé.xlsm", True
If Workbooks("Partagé.xlsm").ReadOnly = True Then
    Workbooks("Partagé.xlsm").Close
    MsgBox ("fichier occupé")
    Exit Sub
End If

Lorsqu'un utilisateur veut modifier le classeur partagé, une macro ouvre l'ouvre, le modifie et le referme.

Le problème c'est qu'il arrive parfois, quand les 2 utilisateurs l'ouvre en même temps (vraiment à la seconde près, et oui ça arrive), que le classeur s'ouvre malgré tous des 2 cotés

Dans certain cas, ouverture, modification et fermeture des 2 cotés, mais en réalité un écrase l'autre..
Dans d'autres cas, gros bug des deux cotés, excel bloque et finit par planter

Quelqu'un aurait il une autre solution?

Merci d'avance

David

 

[gilbert_RGI]

Re : refuser l'ouverture d'un classeur deja ouvert

Bonjour,

il y a ça

Option Explicit

'VériTi ... [url=http://excel.veriti.net]site des amis d'excel - veriti[/url]
'dans l'évènement Open du classeur...
Private Sub Workbook_Open()
ThisWorkbook.IsAddin = False
End Sub

'dans l'évènement BeforeSave ou BeforeClose du classeur...
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.IsAddin = True
End Sub

'ainsi, si on ouvre le classeur alors que les options de sécurité bloquent l'exécution des macros, le classeur reste invisible...(mais pas VBA)

 

[Bougla972]

Re : refuser l'ouverture d'un classeur deja ouvert

Bonjour David,

Une fonction qui permet de tester si un classeur est déjà ouvert par un autre utilisateur.
Il faut appeler cette fonction dans la procédure d'ouverture du classeur.

'Fonction pour empecher l'ouverture d'un fichier en Lecture Seule
Function IsFileOpen(filename As String)
' (code Microsoft :
' http://support.microsoft.com/default.aspx?scid=kb;EN-US;q138621)
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, file is being queried.
    Case Else
      Error errnum
  End Select

End Function

A + Bougla

 

[David590]

Re : refuser l'ouverture d'un classeur deja ouvert

Merci pour vos réponses

Bougla972,

Effectivement, j'avais déjà essayé cette fonction, mais malheureusement le résultat est identique

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

gilbert_RGI,

Je n'arrive pas trop à comprendre ce code, quand tu dis "si on ouvre le classeur alors que les options de sécurité bloque.." je pense que mon problème c'est que la sécurité qui doit normalement empêcher de rouvrir le classeur s'active trop tard

Je ne sais pas trop comment cela fonctionne mais j'imagine :

1-ouverture par le 1er utilisateur (lecture/écriture)
2-le classeur se verrouille et s'ouvrira en lecture seule si un autre utilisateur essai de l'ouvrir

mais je ne sais pas pourquoi mais mon 2e utilisateur arrive par moment à l'ouvrir en se glissant entre l'etape 1 et 2

donc comme ceci:

1-ouverture par le 1er utilisateur (lecture/écriture)
2-ouverture par le 2e utilisateur (lecture/écriture)
3-seulement maintenant le classeur se verrouille et s'ouvrira en lecture seule si un autre utilisateur essai de l'ouvrir

tout ca sert à une caisse enregistreuse pour mon restaurant, les 2 caisses copies les commandes dans le fichier partagé, ainsi la caisse 1 ajoute une commande dans le classeur partagé et il est possible que ce soit la caisse 2 qui aille la récupérer pour la facturer, il arrive donc relativement frequement que la caisse 1 et la caisse 2 essaie de mettre a jour le classeur partagé en meme temps, et la par moment ca coince

Cela fait 2 ans que j'utilise ce système que j'ai codé grâce à toute l'aide du forum, j'ai vraiment une caisse ultra personnalisée et j'en suis ravi hormis ces bug qui sont vraiment tres ennuyeux, je n'ai jamais trouvé de solution et commence à me faire à l'idée qu'il y en a peut être pas, je m'en remets donc à vous les pros, vous être ma derniere chance lol

 

[Dranreb]

Re : refuser l'ouverture d'un classeur deja ouvert

Bonjour.

Moi je m'orienterais peur être vers la solution suivante ou une autre du même style: À l'aide d'instructions Open, Print #, Close, les classeurs de saisie fabriquent rapidement de petits fichiers textes, à chacune d'elles (car ce n'est pas à eux d'ouvrir un classeur central pour le mettre à jour).
Le classeur central, ouvert lui aussi en permanence, vérifie périodiquement l'existence de tels fichiers, les prend en compte pour mettre à jour sa base puis les détruit après s'être sauvegardés.
Comme ça, plus de conflit !

 

[Dranreb]

Re : refuser l'ouverture d'un classeur deja ouvert

Voici un exemple de code pour 'Envoyer' :

Option Explicit

Sub Essai()
Consigne "Toto", 123.45, False
End Sub

Sub Consigne(ParamArray T())
Dim Chemin As String, NomFic As String, C As Long
Chemin = ThisWorkbook.Path & "\Communication"
ChDrive Chemin
On Error Resume Next: ChDir Chemin
If Err Then MkDir Chemin: ChDir Chemin
On Error GoTo 0
NomFic = "Com" & Format(Now, "yymmddhhmm") & _
   Format(VBA.Timer * 100, "0000") & ".txt"
Open NomFic For Output Access Write As 1
For C = LBound(T) To UBound(T): Write #1, T(C): Next C
Close #1
End Sub

La procédure pour récupérer suivra…

 

[David590]

Re : refuser l'ouverture d'un classeur deja ouvert

Ton idée m’intéresse grandement, par contre je connais pas du tout open, print#, close
J’étais en train de faire des recherches puis j'ai vu ton exemple, ca me fera énormément de changement à faire mais je pense que l'idée est vraiment bonne et que ce sera vraiment plus stable
je vais continuer de comprendre et adapter ton code en attendant de voir comment recuperer

Merci beaucoup

 

[David590]

Re : refuser l'ouverture d'un classeur deja ouvert

Et peut on directement envoyer un groupe de cellule?

quand j'essai ceci par exemple ca fonctionne: Consigne Feuil1.Range("A1"), 123.45, False
mais pas quand je fais ca: Consigne Feuil1.Range("A1:A100"), 123.45, False

 

[Dranreb]

Re : refuser l'ouverture d'un classeur deja ouvert

Pourquoi auriez vous à consigner plusieurs lignes, donc plusieurs prises de commandes ?
La procédure pour récupérer les prises de commandes en attente de prise en compte pourrait s'écrire comme ça dans le classeur central :

Sub Récupérer()
Dim Chemin As String, NomFic As String, L As Long, TNomF() As String, _
   TRés(), C As Long
Chemin = ThisWorkbook.Path & "\Communication"
ChDrive Chemin
On Error Resume Next: ChDir Chemin
If Err Then Exit Sub
On Error GoTo 0
NomFic = Dir("Com*.txt")
While NomFic <> "": L = L + 1
   ReDim Preserve TNomF(1 To L)
   TNomF(L) = NomFic
   NomFic = Dir: Wend
ReDim TRés(1 To L, 1 To 4)
For L = 1 To UBound(TNomF)
   TRés(L, 1) = FileDateTime(TNomF(L))
   C = 1
   Open TNomF(L) For Input Access Read As #1
   While Not EOF(1)
      C = C + 1
      Input #1, TRés(L, C): Wend
      Close #1: Next L
Feuil1.Cells(60000, "A").End(xlUp).Offset(1) _
   .Resize(UBound(TRés, 1), UBound(TRés, 2)).Value = TRés
ThisWorkbook.Save
For L = 1 To UBound(TNomF)
   Kill TNomF(L): Next L
End Sub

Elle pourrait être exécutée en boucle par :

Application.OnTime Now + TimeSerial(0, 0, 5), "Récupérer"

La Procédure Consigne telle que je l'ai écrite serait plus adaptée à des infos venant d'un UserForm. Mais peu de modifications seraient nécessaires pour qu'il puisse traiter un tableau, qu'il vienne ou non d'une Value de Range.

 

[David590]

Re : refuser l'ouverture d'un classeur deja ouvert

Ca m'indique "erreur d’exécution 9 l'indice n'appartient pas à la sélection" a ce niveau

Input #1, TRés(L, C)

En fait j'envoi beaucoup de renseignement dans ce classeur partagé, les commandes par téléphone, actuellement chaque caisse classe chaque commande dans le planning du classeur partagé et c'est lui qui donne l'heure suivante pour la prochaine commande

Par exemple, pour des pizzas par téléphone, un client appel, me demande 7 pizzas, après avoir tapé sa commande, j'appuis sur un bouton de la caisse et ça interroge le classeur partagé et me dit pour 7 pizzas ça sera prêt pour 20h10
Puis des que je valide, tout les infos sont envoyé sur le classeur partagé et integré au planning


Ca va peut-etre etre compliqué de refaire ca avec les fichiers textes finalement, non?

Aussi je n'avais pas pensé mais j'ai besoin de voir le classeur partagé pour récupérer la commande que je dois facturer, si il s'actualise avec les fichiers texte, il reste toujours ouvert sur le pc1, le pc2 ne pourrait visualisé le classeur partagé.. ?

 

[Dranreb]

Re : refuser l'ouverture d'un classeur deja ouvert

Les classeurs sont plus long à ouvrir que des fichiers textes.
S'il y a des risques que le classeur central soit ouvert par plusieurs passeurs de commandes en même temps, il vaut mieux que ce classeur soit ouvert en permanence sur un autre poste et se charge lui même de sa mise à jour.
Il pourrait à son tour écrire en réponse le contenu d'une plage dans un fichier unique par cette procédure :

Sub ÉcrirePlage(ByVal Plage As Range)
Dim Chemin As String, Te(), Le As Long, Ts() As String, C As Long
Chemin = ThisWorkbook.Path & "\Communication"
ChDrive Chemin
Te = Plage.Value
Open "TableauCentral.txt" For Output Access Write As #1
ReDim Ts(0 To UBound(Te, 2) - 1)
For Le = 1 To UBound(Te, 1)
   For C = 1 To UBound(Te, 2)
      Select Case VarType(Te(Le, C))
         Case vbString: Ts(C - 1) = """" & Replace(Te(Le, C), """", """""") & """"
         Case vbDouble: Ts(C - 1) = Te(Le, C):
         Case Else: Ts(C - 1) = "": End Select: Next C
   Print #1, Join(Ts, vbTab): Next Le
Close #1
End Sub

Les classeurs satellites pourraient en prendre connaissance par celle ci :

Sub LirePlage(ByVal Plage As Range, Optional ByVal CelHeure As Range, Optional ByVal Abandonner As Boolean = True)
Dim Chemin As String, DatHMàJ As Date, DatHFic As Date, Te() As String, Ts(), Ls As Long, Z As String, C As Long
Chemin = ThisWorkbook.Path & "\Communication"
ChDrive Chemin
If Not CelHeure Is Nothing Then
   DatHMàJ = CelHeure.Value
   Do: DatHFic = FileDateTime("TableauCentral.txt")
      If DatHFic > DatHMàJ Then Exit Do
      If Abandonner Then Exit Sub
      DoEvents: Loop
   CelHeure.Value = DatHFic: End If
ReDim Ts(1 To 50000, 1 To 100)
Open "TableauCentral.txt" For Input Access Read As #1
While Not EOF(1)
   Line Input #1, Z: Te = Split(Z, vbTab)
   If UBound(Te) + 1 > UBound(Ts, 2) Then ReDim Preserve Ts(1 To 50000, 1 To UBound(Te) + 1)
   For C = 0 To UBound(Te)
      Ls = Ls + 1
      If Left$(Te(C), 1) = """" Then
         Ts(Ls, C + 1) = Replace$(Mid$(Te(C), 2, Len(Te(C)) - 1), """""", """")
      ElseIf IsNumeric(Te(C)) = "" Then
         Ts(Ls, C + 1) = CDbl(Te(C))
         End If: Next C
   Close #1: Wend
Plage.ClearContents
Plage.Resize(Ls, UBound(Ts, 2)).Value = Ts
End Sub

 

[David590]

Re : refuser l'ouverture d'un classeur deja ouvert

Oui c'est vrai que les classeurs sont trop long à s'ouvrir,
par contre je ne sais pas ce que je fait mal mais il n'y a que le premier code que j'ai réussi a faire fonctionner
celui pour récupérer j'ai "erreur d’exécution 9 l'indice n'appartient pas à la sélection"
et les 2 derniers il ne se passe rien

 

[Dranreb]

Re : refuser l'ouverture d'un classeur deja ouvert

Exact. J'avais repéré que ce problème pouvait se présenter s'il ne subsistait plus aucun fichier de consigne à traiter.
Mon code actuel est le suivant :

Sub Récupérer()
Dim Chemin As String, NomFic As String, TNomF() As String, _
   Ti(), Li As Long, C As Long, Cible As Range
Chemin = ThisWorkbook.Path & "\Communication"
ChDrive Chemin
On Error Resume Next: ChDir Chemin
If Err Then Exit Sub
On Error GoTo 0
NomFic = Dir("Com*.txt")
While NomFic <> "": Li = Li + 1
   ReDim Preserve TNomF(1 To Li)
   TNomF(Li) = NomFic
   NomFic = Dir: Wend
If Li = 0 Then Exit Sub
ReDim Ti(1 To Li, 1 To 4)
For Li = 1 To UBound(TNomF)
   Ti(Li, 1) = FileDateTime(TNomF(Li))
   C = 1
   Open TNomF(Li) For Input Access Read As #1
   While Not EOF(1)
      C = C + 1
      Input #1, Ti(Li, C): Wend
   Close #1: Next Li
Feuil1.Cells(60000, "A").End(xlUp).Offset(1) _
   .Resize(UBound(Ti, 1), UBound(Ti, 2)).Value = Ti
ThisWorkbook.Save
For Li = 1 To UBound(TNomF): Kill TNomF(Li): Next Li
End Sub

Ce serait quand même plus simple si vous joigniez vos classeur, qui doivent tous être dans le même dossier réseau identifié si possible par une lettre de lecteur, j'ai oublié de le préciser. Pour les tests les fichiers de communication sont provisoirement mis dans un sous-dossier de celui où se trouvent les classeurs, nommé "Communication".
Une autre chose que j'ai oublié de préciser: À terme aucune de ces procédures ne sera à exécuter manuellement, mais à appeler par d'autres procédures qui dépendront du contexte, notamment de la structure du tableau dans le classeur central, et de ce qu'il faudra renvoyer aux classeurs satellites.

 

[David590]

Re : refuser l'ouverture d'un classeur deja ouvert

Oui je peux joindre mes classeurs mais je ne suis pas certain que ce sera plus simple car c'est un sacré bric a brac, disons que j'ai réussi à faire une caisse en vba avec ce que j'ai pu comprendre mais c'est certainement loin d’être les codes les plus court lol
Es ce que ce ne serait pas plus simple pour vous de d'utiliser des classeurs vierge .. comme ca je me débrouille après pour adapter à mes classeurs
Je n'arrive pas à faire fonctionner vos codes LirePlage et EcrirePlage
Je vous joins donc mes classeurs tout de même

CEA&Journée.xlsm est le classeur commun qui contient les Commandes en attentes et les données facturation de la journée

et Caisse.xlsm est la caisse..

 

[David590]

Re : refuser l'ouverture d'un classeur deja ouvert

oups les fichiers ne passe pas,

Caisse.xlsm - Votre fichier de 2,13 Mo octets dépasse la limite du forum de 293,0 Ko pour ce type de fichier.
CEA&Journée.xlsm - Votre fichier de 366,1 Ko octets dépasse la limite du forum de 293,0 Ko pour ce type de fichier.

Connaissez vous une autre solution?
Je vais essayé de faire des classeurs exemple sinon..