Bonjour,

Je cherche à développer une solution pour la gestion multi-utilisateur à distance dans le cadre du télétravail.
J'utilise pour cela un dossier sur un disque réseau dans lequel je stocke des mini fichiers texte avec pour titre la ligne en cours d'utilisation ainsi que le nom de l'utilisateur.
Cela fonctionne parfaitement et de façon instantanée en local. mais les temps de réponses à distance sont trop long (entre 5 et 10 secondes de temps mort entre chaque cellule).
J'espère être clair.

Je cherche donc à optimiser un maximum afin de réduire le temps de traitement.
Toutes les idées sont les bienvenues!!!!


Voici ma fonction qui est déclenchée par Workbook_SheetSelectionChange

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Function verrouillage(ByVal ligne As String) As Boolean
    Dim CheminVerrou As String
    Dim fs As Scripting.FileSystemObject
    Dim UtilisateurActuel As Boolean
 
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set dossiersource = fs.GetFolder("V:\SEB - Test Télétravail\verrou\")
 
    For Each fichier In dossiersource.Files
        If Left(fichier.Name, Len(ligne)) = ligne Then
            If InStr(1, fichier.Name, Application.UserName) = 0 Then
                UtilisateurActuel = False
                MsgBox "cette ligne est vérouillée par " & Mid(fichier.Name, Len(ligne) + 2, InStr(Len(ligne) + 2, fichier.Name, "-") - Len(ligne) - 2)
                verrouillage = True
                Exit For
            Else
                UtilisateurActuel = True
            End If
        Else
            verrouillage = False
        End If
    If InStr(1, fichier.Name, Application.UserName) Then
        On Error GoTo errorHandler
        Kill dossiersource & "\" & fichier.Name
        On Error GoTo 0
    End If
    Next fichier
 
    If verrouillage = False Then
        Set a = fs.CreateTextFile("V:\SEB - Test Télétravail\verrou\" & ActiveCell.Row & "-" & Application.UserName & "-" & Replace(Date, "/", ".") & "-" & Replace(TimeValue(Now), ":", "."), True)
        If UtilisateurActuel = False Then MsgBox "ligne libre!!"
    Else
        Application.EnableEvents = False
        ActiveCell.Offset(1, 0).Select
        Application.EnableEvents = True
        Set a = fs.CreateTextFile("V:\SEB - Test Télétravail\verrou\" & ActiveCell.Row & "-" & Application.UserName & "-" & Replace(Date, "/", ".") & "-" & Replace(TimeValue(Now), ":", "."), True)
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
Exit Function
errorHandler:
    a.Close
    Resume
End Function
Merci de m'avoir lu!