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

 

[Dranreb]

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

Il faudra apprendre à vous servir de tableaux en mémoire. Parce que j'ai délocalisé la prise en compte des consignes vers une procédure IntégrerConsignes qui vous passe en paramètre un tableau 2D des valeurs de consignes, à raison d'une ligne pour chaque.
Par contre je pense que dans ma prochaine version je mettrai des commentaires guides d'utilisation au début de chaque procédure de communication. J'en assurerai la mise au point, ne vous inquiétez pas.

 

[David590]

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

Super merci

 

[David590]

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

Je viens d'essayer le fonctionnement de mes classeurs tous dans le même dossier distant et ça ne pose pas de problème de ralentissement, donc tous dans le même dossier n'est pas genant

 

[Dranreb]

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

Ce sont les fichier de communication dont l'emplacement doit être bien clair. Dans le même dossier aussi ? Si oui mettez en commentaires toutes les instructions ChDrive et ChDir
Pour l'instant je les laisse. Je joins la version avec les commentaires en tête des procédures de communication.

 

[David590]

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

Vraiment désolé mais je ne saisi toujours pas

Apparemment je dois compléter le nom des fichiers et les plages de cellules?

Je n'arrive à rien, sans vouloir abuser ne pourriez vous pas intégrer ces codes dans 2 classeurs pour que le premier envoi dans un fichier texte et que le deuxième récupère ce fichier texte?

Et tous sera bien dans le même dossier, ça ne pose pas de problème

 

[Dranreb]

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

Il faut les transmettre en paramètres aux procédures lors de leur appel, c'est à dire en les écrivant derrière le nom de la procédure, séparés par des virgules.
Par exemple :

Sub Test1()
Distribuer "Essai", ActiveSheet.Range("I3:K5")
End Sub

Sub Test2()
Récupérer "Essai", ActiveSheet.Range("I7:K9")
End Sub

Oups. Gros problèmes en exécutant la Test 2. Procédure déboguée:

Sub Récupérer(ByVal NomFic As String, ByVal Plage As Range, _
   Optional ByVal CelHeure As Range, Optional ByVal Abandonner As Boolean = True)
Rem. ——— Récupérer dans une plage le contenu d'un fichier texte fabriqué
'        par la procédure Distribuer du classeur central.
'    NomFic: Le nom du fichier à récupérer, sans l'extension ".txt".
'    Plage: La plage devant recevoir le contenu du fichier.
'    CelHeure: Cellule contenant la date et l'heure de modification du fichier de même nom
'        qui avait été récupéré pour la dernière fois. Si l'heure du fichier existant est
'        toujours la même, la récupération n'a pas lieu. Sinon la cellule est corrigée.
'        Facultatif. Si non précisée la procédure est toujours exécutée.
'    Abandonner: Option facultative, sans objet si CelHeure n'est pas spécifiée.
'        True ou omis     —> Si la date n'a pas changé, la récupération n'a pas lieu.
'        Spécifié à False —> La procédure garde la main jusqu'à ce qu'elle change (dans
'                              certaines limites).
Dim Chemin As String, DatHMàJ As Date, DatHFic As Date, DatHMsg As Date, _
   Te() As String, Ts(), Ls As Long, Z As String, C As Long, Rép As VbMsgBoxResult
CheminChemin = ThisWorkbook.Path & "\Communication"
ChDrive Chemin
On Error Resume Next: ChDir Chemin
If Err Then MkDir Chemin: ChDir Chemin
On Error GoTo 0
If Not CelHeure Is Nothing Then
   DatHMàJ = CelHeure.Value
   DatHMsg = Now + TimeSerial(0, 0, 10)
   Do: DatHFic = FileDateTime(NomFic & ".txt")
      If DatHFic > DatHMàJ Then Exit Do
      If Abandonner Then Exit Sub
      If Now > DatHMsg Then
         If Rép = vbIgnore Then Exit Sub
         Rép = MsgBox("La réponse du classeur central tarde…" & vbLf _
            & "Si vous réessayez, à dans 20 secondes !", _
            vbAbortRetryIgnore + vbInformation, "Communication")
         If Rép = vbAbort Then Exit Sub
         DatHMsg = Now + TimeSerial(0, 0, 20): End If
      DoEvents: Loop
   CelHeure.Value = DatHFic: End If
ReDim Ts(1 To 50000, 1 To 100)
Open NomFic & ".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)
   Ls = Ls + 1
   For C = 0 To UBound(Te)
      If Left$(Te(C), 1) = """" Then
         Ts(Ls, C + 1) = Replace$(Mid$(Te(C), 2, Len(Te(C)) - 2), """""", """")
      ElseIf IsNumeric(Te(C)) Then
         Ts(Ls, C + 1) = CDbl(Te(C))
         End If: Next C: Wend
Close #1
Application.EnableEvents = False
Plage.ClearContents
Plage.Resize(Ls, UBound(Ts, 2)).Value = Ts
Application.EnableEvents = True
End Sub