Geschützte Excel Datei von Kollegen über Makro schließen

  • Excel

Es gibt 9 Antworten in diesem Thema. Der letzte Beitrag () ist von 3DFreak77.

    Geschützte Excel Datei von Kollegen über Makro schließen

    Hallo liebe Community,
    sollte dieses Thema bereits schon mal behandelt worden sein - bitte einen Link zum Thread.

    Ich habe folgende Problemsituation:
    Wir haben eine Arbeitsmappe, die einen Blattschutz hat und von mehreren Kollegen geöffnet werden kann. Soweit so gut, wenn ich aber daran etwas ändern möchte, muss ich denjenigen Kollegen, der sie gerade offen hat, anrufen oder im Büro besuchen und um Schließen der Datei zu bitten.
    Es gab bereits Überlegungen und Versuche hinsichtlich "Arbeitsmappe freigeben", aber das funktionierte nicht so, wie wir uns das vorstellten.

    Deshalb würde ich gerne eines machen:
    Mittels Makro die Tastatur- und Mausaktivität eine gewisse Zeitspanne lang beobachten und falls keine positive Rückmeldung kommt (von Tastatur oder Maus) dann die Arbeitsmappe speichern und schließen.

    Besten Dank für eure Inputs gleich mal vorweg. :thumbsup: 8o

    Gruß
    3DFreak

    Moin' moin'

    Grundsätzlich sicherlich möglich. Makros werden in VBA geschrieben.

    Der Code müsste ungefähr folgendes machen.
    1x Timer zur Überprüfung der Mausaktivität und Tastaturaktivität
    1x Timer für die Form IDLE, wenn diese Zeit abgelaufen ist, schliesst sich das Excel.

    Für die Mausaktivität müsstest du die Koordinaten der Maus kontinuierlich mit einem Vorher und Nachher Wert vergleichen.
    Für die Tastatureingabe gibt es sicherlich schon fix fertige Codes. Wahrscheinlich mit einem Keyboard Hook. Is'n Keylogger, wenn ihr Antivirensoftware habt, wird dieser ausschlagen. Nur so zur Info.
    "Die menschliche Vorstellungskraft ist unendlich"
    ->Versuch dir mal 'ne neue Farbe auszudenken!

    Mit Schleifen kann man alles lösen!

    Dim d as Double = 1
    Do until d = 0
    d = (d / 2)
    Loop ∞

    Hallo @3DFreak77
    Ich hab da mal was ähnliches gemacht.
    Nach 9 Minuten Inaktivität kommt eine Meldung, dass das Workbook in einer Minute geschlossen wird.

    Code in Modul

    Visual Basic-Quellcode

    1. Option Explicit
    3. Public dteCloseTime As Date, blnCloseNow As Boolean
    5. Public Sub DoClose()
    6. Dim strMsg As String
    7. If blnCloseNow = False Then
    9. strMsg = "Diese Datei wurde seit 9 Minuten nicht bearbeitet und"
    10. & vbCrLf & "wird bei weiterer Inaktivität in 1 Minute
    11. geschlossen."
    12. CreateObject("WScript.Shell").PopUp strMsg, 10, ThisWorkbook.Name, vbOKOnly + vbInformation + vbSystemModal
    13. blnCloseNow = True
    14. dteCloseTime = Now + TimeSerial(0, 1, 0)
    15. Application.OnTime dteCloseTime, "DoClose"
    16. Else
    17. If Workbooks.Count = 1 Then
    18. Application.DisplayAlerts = False
    19. Application.Quit
    20. Else
    21. ThisWorkbook.Close True
    22. End If
    23. End If
    24. End Sub


    Code in ThisWorkbook

    Visual Basic-Quellcode

    1. Private Sub Workbook_BeforeClose(Cancel As Boolean)
    2. On Error Resume Next
    3. Application.OnTime dteCloseTime, "DoClose", , False
    4. End Sub
    6. Private Sub Workbook_Open()
    7. dteCloseTime = Now + TimeSerial(0, 9, 0)
    8. Application.OnTime dteCloseTime, "DoClose"
    9. End Sub
    11. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    12. On Error Resume Next
    13. Application.OnTime dteCloseTime, "DoClose", , False
    14. dteCloseTime = Now + TimeSerial(0, 9, 0)
    15. blnCloseNow = False
    16. Application.OnTime dteCloseTime, "DoClose"
    17. End Sub
    19. Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    20. On Error Resume Next
    21. Application.OnTime dteCloseTime, "DoClose", , False
    22. dteCloseTime = Now + TimeSerial(0, 9, 0)
    23. blnCloseNow = False
    24. Application.OnTime dteCloseTime, "DoClose"
    25. End Sub
    27. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    28. On Error Resume Next
    29. Application.OnTime dteCloseTime, "DoClose", , False
    30. dteCloseTime = Now + TimeSerial(0, 9, 0)
    31. blnCloseNow = False
    32. Application.OnTime dteCloseTime, "DoClose"
    33. End Sub


    Gruss HenryV

    Hallo M-Stef, moin moin ...

    Danke für die prompte Antwort.
    Ist dann eine Überwachung der Mausaktivität auf Excel begrenzt oder betrifft sie das System? Das gleiche würde dann für die Tastatur gelten.
    Denn einerseits möchte ich vermeiden, dass die Arbeitsmappe geschlossen wird, nur weil man auf irgendeinem pdf eine Nummer sucht; andererseits möchte ich vermeiden, dass die Arbeitsmappe geöffnet bleibt, obwohl derjenige gar nichts im Excel macht sondern zB im Outlook ein Mail schreibt.

    Demzufolge bräuchte ich wahrscheinlich sogar 3 Timer ...
    also
    1x Timer für Tastatur (zusätzlich)
    1x Timer für Maus
    1x Timer für IDLE (danach speichern und schließen)

    Aber zu kompliziert möchte ich es auch nicht machen, habe etwas von der Funktion PSKill gehört.
    Wie funktioniert die? Welche Angaben würde ich dafür brauchen?
    Oder geht das mit net file ... auch? Weil ich weiß ja, welcher User die Datei geöffnet hat (aus dem Fenster wegen schreibgeschützt öffnen)

    DANKE!

    LG
    3DFreak

    3DFreak77 schrieb:

    Ist dann eine Überwachung der Mausaktivität auf Excel begrenzt
    Nein.
    Es ist gar keine Überwachung der Mausaktivität, sondern der Excel-Events.
    Und diese Lösung ist meiner Ansicht nach wesentlich eleganter als Maus- und Tastaturüberwachung.

    Allenfalls die Art und Weise der Speicherung würde ich überdenken.
    Vor dem Zwangs-Exit würde ich ein Workbook.SaveAs absetzen, falls das Workbook.Saved Flag nicht gesetzt ist.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    @3DFreak77
    Schau dir das an, das ist wahrscheinlich genau was du brauchst. :)
    Ist genau die gleiche Problemstellung.
    Nicht mit Timer gelöst, sondern mit Excel Events.

    office-loesung.de/ftopic442760_0_0_asc.php

    Grüsse
    "Die menschliche Vorstellungskraft ist unendlich"
    ->Versuch dir mal 'ne neue Farbe auszudenken!

    Mit Schleifen kann man alles lösen!

    Dim d as Double = 1
    Do until d = 0
    d = (d / 2)
    Loop ∞

    Hallo zusammen,
    ich bin noch gar nicht dazu gekommen, meinen Hut vor euch zu ziehen ... :thumbsup:
    Danke vielmals für eure prompte Unterstützung.
    Das funktioniert einwandfrei, echt genial.

    Einen letzten kleinen Gimmick hätte ich noch:
    - Kann man überprüfen, ob die Datei schreibgeschützt geöffnet wurde? Denn da macht es ehrlich wenig Sinn, dass die schließt, wenn ich da sowieso nichts eintragen kann
    - Kann man einen "Superuser" definieren, bei dem das Makro anders oder gar nicht läuft?

    Besten Dank.

    LG
    3DFreak77

    Hallo @3DFreak77
    Klar geht das. Hier der abgeänderte Code, mit der Abfrage ReadOnly oder Username = "3DFreak77" = nicht automatisch schliessen.
    Code in ThisWorkbook

    Visual Basic-Quellcode

    1. Public NoAutoClose As Boolean
    3. Private Sub Workbook_BeforeClose(Cancel As Boolean)
    4. If NoAutoClose Then Exit Sub
    5. On Error Resume Next
    6. Application.OnTime dteCloseTime, "DoClose", , False
    7. End Sub
    9. Private Sub Workbook_Open()
    10. NoAutoClose = False
    11. If Application.ActiveProtectedViewWindow Is Nothing Then 'Check Protected View
    12. If ThisWorkbook.ReadOnly Or Environ("USERNAME") = "3DFreak77" Then 'Check Readonly or Username
    13. NoAutoClose = True
    14. Exit Sub
    15. End If
    16. dteCloseTime = Now + TimeSerial(0, 9, 0)
    17. Application.OnTime dteCloseTime, "DoClose"
    18. End If
    19. End Sub
    21. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    22. If NoAutoClose Then Exit Sub
    23. On Error Resume Next
    24. Application.OnTime dteCloseTime, "DoClose", , False
    25. dteCloseTime = Now + TimeSerial(0, 9, 0)
    26. blnCloseNow = False
    27. Application.OnTime dteCloseTime, "DoClose"
    28. End Sub
    30. Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    31. If NoAutoClose Then Exit Sub
    32. On Error Resume Next
    33. Application.OnTime dteCloseTime, "DoClose", , False
    34. dteCloseTime = Now + TimeSerial(0, 9, 0)
    35. blnCloseNow = False
    36. Application.OnTime dteCloseTime, "DoClose"
    37. End Sub
    39. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    40. If NoAutoClose Then Exit Sub
    41. On Error Resume Next
    42. Application.OnTime dteCloseTime, "DoClose", , False
    43. dteCloseTime = Now + TimeSerial(0, 9, 0)
    44. blnCloseNow = False
    45. Application.OnTime dteCloseTime, "DoClose"
    46. End Sub

Facebook
Telefonspende