Données partagées en temps réel sur Excel

Re,

Attention O365 c'est aussi un pack office qui s'installe en local sur les postes et je parle de cette version

Il est simple d'ouvrir un fichier Excel sur Teams ou Edge avec Excel 365 installé sur le poste, ce qui permet d'avoir les macros exécutables.

En revanche cela ne fonctionne pas sur Chrome ou Firefox avec les macros

Il est malheureusement nécessaire que chaque collaborateur est cette version 365

fourmi a écrit :

en fait tu peux travailler sur une page web ( navigateur chrome, Firefox ou autre) mais tu ne peux avoir accès à la vba. Par contre, tu peux ouvrir directement excel "l'application" et travailler en temps réel aussi avec l’accès à l'ensemble des fonctions de l'application. Tu verra les personne connectés à ton fichier, leur déplacement dans les cases etc..c'est un peu comme google sheet. C'est la meilleure solution : office 365 en activant l'enregistrement automatique.

D'accord je comprends mieux J'y penserais à cette solution pour de futurs fichiers. Mais sur ce sujet, j'ai peur que le changement d'habitudes soit trop brutal pour un fichier dont le fonctionnement est depuis longtemps dans les mœurs :/

BrunoM45 a écrit :

En revanche cela ne fonctionne pas sur Chrome ou Firefox avec les macros

J'ai poursuivi mon projet, surtout pour le fun !

Au lieu des msgbox qui peuvent être perturbants, j'utilise la statusbar pour indiquer les synchros.

J'enregistre aussi en fichier "central" les heures de synchro de chacun afin d'épurer à terme le log.

Public Intervalle As Date

Sub synchUP(plage As Range)
Dim cel As Range, ici As Range
Dim wb1 As Workbook, wb2 As Workbook, ws1 As Worksheet, ws2 As Worksheet, tbl1 As ListObject, tbl2 As ListObject, log As ListObject
Set wb1 = ThisWorkbook: Set ws1 = wb1.Sheets("data"): Set tbl1 = ws1.ListObjects(1)

    source = LireFichierTexte(ThisWorkbook.Path & "\source.txt")
    Application.EnableEvents = False

    If Not FichierDejaOuvert(source) Then
        Set wb2 = Workbooks.Open(source): Set ws2 = wb2.Sheets("data"): Set tbl2 = ws2.ListObjects(1)
        Set log = wb2.Sheets("log").ListObjects(1)
        For Each cel In plage
            identifiant = ws1.Cells(cel.Row, 1)

            With tbl2
                Set ici = .ListColumns(1).DataBodyRange.Find(identifiant)
                If Not ici Is Nothing Then
                    i = ici.Row - .HeaderRowRange.Row
                Else
                    .ListRows.Add
                    i = .ListRows.Count
                    .DataBodyRange(i, 1) = identifiant
                End If
                j = cel.Column - tbl1.DataBodyRange(1, 1).Column + 1
                .DataBodyRange(i, j) = ws1.Cells(cel.Row, cel.Column)
            End With

            With log
                .ListRows.Add
                .DataBodyRange(.ListRows.Count, 1) = Split(wb1.Name, ".")(0)
                .DataBodyRange(.ListRows.Count, 2) = identifiant
                .DataBodyRange(.ListRows.Count, 3) = j
                .DataBodyRange(.ListRows.Count, 4) = ws1.Cells(cel.Row, cel.Column)
                .DataBodyRange(.ListRows.Count, 5) = Now
            End With

        Next
        wb1.Sheets("der").Range("_synchup") = Now
        wb2.Close True
        Application.StatusBar = "activité de synchronisation montante ok !"

    Else
        MsgBox "activité de synchronisation en cours, modification annulée !"
        Application.Undo
    End If

    Application.EnableEvents = True

End Sub

Sub synchDown(ok As Boolean)
Dim cel As Range, ici As Range
Dim wb1 As Workbook, wb2 As Workbook, ws1 As Worksheet, ws2 As Worksheet, tbl1 As ListObject, tbl2 As ListObject, log As ListObject, der As ListObject
Set wb1 = ThisWorkbook: Set ws1 = wb1.Sheets("data"): Set tbl1 = ws1.ListObjects(1)

    source = LireFichierTexte(ThisWorkbook.Path & "\source.txt")
    Application.EnableEvents = False

    If Not FichierDejaOuvert(source) Then
        Set wb2 = Workbooks.Open(source): Set ws2 = wb2.Sheets("data"): Set tbl2 = ws2.ListObjects(1)
        Set log = wb2.Sheets("log").ListObjects(1): Set der = wb2.Sheets("der").ListObjects(1)
        For Each cel In log.ListColumns(1).DataBodyRange
            If cel.Offset(0, 4) > wb1.Sheets("der").Range("_synchdown") Then
                identifiant = cel.Offset(0, 1)

                With tbl1
                    Set ici = .ListColumns(1).DataBodyRange.Find(identifiant)
                    If Not ici Is Nothing Then
                        i = ici.Row - .HeaderRowRange.Row
                    Else
                        .ListRows.Add
                        i = .ListRows.Count
                        .DataBodyRange(i, 1) = identifiant
                    End If
                    j = cel.Offset(0, 2)
                    .DataBodyRange(i, j) = cel.Offset(0, 3)
                End With

            End If
        Next

        With der
            Set ici = .ListColumns(1).DataBodyRange.Find(wb1.Name)
            If Not ici Is Nothing Then
                i = ici.Row - .HeaderRowRange.Row
            Else
                .ListRows.Add
                i = .ListRows.Count
            End If
            .DataBodyRange(i, 1) = wb1.Name
            .DataBodyRange(i, 2) = Now
        End With

        wb1.Sheets("der").Range("_synchdown") = Now
        wb2.Close True
        Application.StatusBar = "dernière activité de synchronisation descendante le " & Now & " !"

    Else
        MsgBox "activité de synchronisation en cours, synchronisation descendante impossible !"
    End If

    Application.EnableEvents = True

End Sub

Sub reactivier()
    Application.EnableEvents = True
End Sub

Sub mymacro()
    Intervalle = Now + TimeValue("00:05:00")
    Application.OnTime Intervalle, "mymacro"
    If Not ActiveWorkbook Is Nothing Then
        synchDown True
        DoEvents
    End If
End Sub

J'avoue, en toute modestie, être assez fier de mon petit bébé !

Bonsoir

Il y a pas de quoi être modeste Steelson Tu peux être fier de ton travail !

Encore merci pour ton investissement, je vais essayer ta nouvelle version.

Je travaille également sur la mienne, et je cherche un moyen de détecter par VBA lorsque l'option de partage (image ci-dessous) est active ou non pour éviter des boulettes de mes collègues sur le fichier... (J'ai essayé en enregistrant une macro mais vu que l'édition des macros est désactivée à l'activation du partage ce fut un cruel échec )

Je pense que je vais créer deux versions de mon fichier (dont ta proposition Steelson) et je les proposerais à mes chefs et collègues. Ils choisiront la version qu'ils préfèrent.