crack24
Goto Top

Excel Änderungen live anzeigen für andere Nutzer

Hallo,

ist es möglich, dass wenn jemand Änderungen in einer Excel macht, andere Nutzer diese sofort live sehen wenn sie die Datei auch geöffnet haben? Oder müssen die die Datei dafür neu öffnen?

Viele Grüße
crack

Content-Key: 249949

Url: https://administrator.de/contentid/249949

Ausgedruckt am: 28.03.2024 um 16:03 Uhr

Mitglied: colinardo
Lösung colinardo 23.09.2014 aktualisiert um 23:14:15 Uhr
Goto Top
Moin,
siehe: Excel07 Excel-Datei von mehreren Arbeitsplätzen öffnen und automatisch aktualisieren

Die Makro-Variante könnte so aussehen:

Man erstelle ein Excel Dokument mit Makros (*.xlsm) in welchem man folgenden Code in den Abschnitt DieseArbeitsmappe im VBA-Editor (ALT-F11) einfügt:
Private Sub Workbook_Open()
    If ThisWorkbook.ReadOnly = True Then
        UpdateTimer
    End If
End Sub

Sub UpdateTimer()
    Application.OnTime (Now() + TimeValue("00:00:05")), "DieseArbeitsmappe.UpdateTimer"  
    On Error Resume Next
    ThisWorkbook.UpdateFromFile
End Sub
Dieses Dokument speichert man nun auf einem Netzlaufwerk. Der Bearbeiter öffnet das Dokument als erstes und hat damit Schreibzugriff auf die Arbeitsmappe. Alle weiteren Clients öffnen dann das Workbook im Schreibgeschützen Modus, und nur hier startet dann das Makro welches eine Aktualisierung der Arbeitsmappe alle X Sekunden (im Beispielcode alle 5 Sekunden) veranlasst. Speichert der Bearbeiter nun das Workbook sind kurz darauf die Änderungen an den Clients zu sehen.

Grüße Uwe
Mitglied: crack24
crack24 23.09.2014 um 23:14:55 Uhr
Goto Top
Hallo Uwe,

das ist genau das was ich brauche! Vielen Dank.

Viele Grüße
crack
Mitglied: crack24
crack24 24.09.2014 um 13:40:57 Uhr
Goto Top
Alle Änderungen eines Tages automatisch farbig zu kennzeichnen ist wahrscheinlich nicht möglich oder?
Mitglied: colinardo
colinardo 24.09.2014 aktualisiert um 14:37:51 Uhr
Goto Top
Zitat von @crack24:
Alle Änderungen eines Tages automatisch farbig zu kennzeichnen ist wahrscheinlich nicht möglich oder?
man kann ein Makro hinterlegen das bei jeder Zelländerung z.B. die Hintergrundfarbe der jeweiligen Zelle automatisch ändert(Worksheets_OnChange-Event). Diese Zellen müsste man dann nur am Anfang eines neuen Tages wieder zurücksetzen. Möglich ist vieles ....
Einfacher lässt sich das natürlich mit einem freigegebenen Workbook machen, das hat diese Funktion ja schon integriert (Änderungen nachverfolgen) - wie unter obigem Link beschrieben.
Mitglied: crack24
crack24 24.09.2014 um 14:15:23 Uhr
Goto Top
wenn man weiß wie es geht face-smile
Dann muss ich mal recherchieren, ob man irgendwie die Zellen auch wieder automatisch zurücksetzen kann.
Mitglied: colinardo
colinardo 24.09.2014 aktualisiert um 17:34:44 Uhr
Goto Top
So, hier mal ein Beispiel das geänderte Zellen gelb hinterlegt und beim Öffnen nachfragt ob die Markierungen alle gelöscht werden sollen. Hier noch das Demo-Sheet dazu: mark_edited_cells_249949.xlsm / Kommentare befinden sich im Code
'Variable enthält den zwischengespeicherten Wert der aktiven Zelle(n)  
Dim currentCellValue As String
'Markerfarbe  
Dim markerColor As Long

'Beim Öffnen des Workbooks checken ob es schreibgeschützt geöffnet wurde  
Private Sub Workbook_Open()
    'Farbe der Marker festlegen  
    markerColor = RGB(255, 255, 0)
    
    If ThisWorkbook.ReadOnly = True Then
        'Workbook schreibgeschützt, starte die 'UpdateTimer' Prozedur  
        UpdateTimer
    Else
        'Workbook ist nicht schreibgeschützt, Frage ob alle Tagesmarkierungen entfernt werden sollen  
        If MsgBox("Möchten sie die Tagesmarkierungen entfernen?", vbQuestion Or vbYesNo, "Tagesmarkierungen") = vbYes Then  
            ClearMarkers
        End If
    End If
End Sub

'Bei Zelländerungen den Wert der Zelle auf Änderung überprüfen und dann entsprechend farbig markieren  
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If Not IsEmpty(Target.Value) Then
        If Target.Cells(1, 1).Value <> currentCellValue Then
            Target.Cells(1, 1).Interior.Color = markerColor
        End If
    Else
        If currentCellValue <> "" Then  
            Target.Cells(1, 1).Interior.Color = markerColor
        End If
    End If
End Sub

'Aktuellen Wert der aktivierten Zelle zwischenspeichern um Zelländerungen feststellen zu können  
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    currentCellValue = Target.Cells(1, 1).Value
End Sub

'Update-Timer wird gestartet wenn das Workbook schreibgeschützt geöffnet wird  
Sub UpdateTimer()
    'Update-Routine alle 5 Sekunden erneut aufrufen  
    Application.OnTime (Now() + TimeValue("00:00:05")), "DieseArbeitsmappe.UpdateTimer"  
    On Error Resume Next
    'Update druchführen  
    ThisWorkbook.UpdateFromFile
End Sub

'Tagesmarkierungen entfernen  
Sub ClearMarkers()
    Dim ws As Worksheet, cell As Range
    For Each ws In ThisWorkbook.Worksheets
        For Each cell In ws.UsedRange
            If cell.Interior.Color = markerColor Then
                cell.Interior.ColorIndex = xlColorIndexNone
            End If
        Next
    Next
End Sub
Viel Erfolg

Grüße Uwe
Mitglied: crack24
crack24 25.09.2014 um 15:37:16 Uhr
Goto Top
Danke! Muss ich am Wochenende direkt mal einbauen und testen face-smile
Mitglied: crack24
crack24 18.10.2014 um 11:16:00 Uhr
Goto Top
Funktioniert super. Zwei Fragen habe ich noch.
Kann man irgendwie auch den Windows User abfragen, so dass die Änderungen eines bestimmten Users nicht markiert werden?
Kann man statt der MsgBox("Möchten sie die Tagesmarkierungen entfernen?") auch einen Button in einer Zelle platzieren der die Markierungen entfernt?

Viele Grüße
Oliver
Mitglied: colinardo
colinardo 18.10.2014 aktualisiert um 11:25:05 Uhr
Goto Top
Hallo Oliver,
Zitat von @crack24:
Funktioniert super. Zwei Fragen habe ich noch.
Kann man irgendwie auch den Windows User abfragen, so dass die Änderungen eines bestimmten Users nicht markiert werden?
yip s. Code unten Zeile 20, dort kannst du den Namen ändern, dann werden Änderungen dieses Users nicht markiert.
Kann man statt der MsgBox("Möchten sie die Tagesmarkierungen entfernen?") auch einen Button in einer Zelle
platzieren der die Markierungen entfernt?
Kannst du mit diesem Code machen, du musst dann nur noch deinen Button erstellen und Ihm das Makro **ClearMarkers()* zuweisen.
'Variable enthält den zwischengespeicherten Wert der aktiven Zelle(n)  
Dim currentCellValue As String
'Markerfarbe  
Dim markerColor As Long

'Beim Öffnen des Workbooks checken ob es schreibgeschützt geöffnet wurde  
Private Sub Workbook_Open()
    'Farbe der Marker festlegen  
    markerColor = RGB(255, 255, 0)
    
    If ThisWorkbook.ReadOnly = True Then
        'Workbook schreibgeschützt, starte die 'UpdateTimer' Prozedur  
        UpdateTimer
    End If
End Sub

'Bei Zelländerungen den Wert der Zelle auf Änderung überprüfen und dann entsprechend farbig markieren  
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    ' Nur ausführen wenn User nicht 'Werner' heißt markiere Änderungen  
    If Application.UserName <> "Werner" Then  
        On Error Resume Next
        If Not IsEmpty(Target.Value) Then
            If Target.Cells(1, 1).Value <> currentCellValue Then
                Target.Cells(1, 1).Interior.Color = markerColor
            End If
        Else
            If currentCellValue <> "" Then  
                Target.Cells(1, 1).Interior.Color = markerColor
            End If
        End If
    End If
End Sub

'Aktuellen Wert der aktivierten Zelle zwischenspeichern um Zelländerungen feststellen zu können  
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    currentCellValue = Target.Cells(1, 1).Value
End Sub

'Update-Timer wird gestartet wenn das Workbook schreibgeschützt geöffnet wird  
Sub UpdateTimer()
    'Update-Routine alle 5 Sekunden erneut aufrufen  
    Application.OnTime (Now() + TimeValue("00:00:05")), "DieseArbeitsmappe.UpdateTimer"  
    On Error Resume Next
    'Update druchführen  
    ThisWorkbook.UpdateFromFile
End Sub

'Tagesmarkierungen entfernen  
Sub ClearMarkers()
    Dim ws As Worksheet, cell As Range
    For Each ws In ThisWorkbook.Worksheets
        For Each cell In ws.UsedRange
            If cell.Interior.Color = markerColor Then
                cell.Interior.ColorIndex = xlColorIndexNone
            End If
        Next
    Next
End Sub
Grüße Uwe
Mitglied: crack24
crack24 18.10.2014 um 12:26:10 Uhr
Goto Top
Danke für deine Hilfe!