VBA - Erkennung von Inaktivität
#1
Hi Leute,

ich möchte gerne, dass meine Mappe bei Inaktivität geschlossen wird und da bin ich auf der Suche nach dem richtigen Makro. Allerdings weiß ich noch nicht so recht, welche Art der Inaktivität dabei am Besten ist. Es handelt sich um eine Datei, die im Netzwerk von mehreren Personen genutzt wird und deswegen nicht blockiert werden soll. Die PCs (Win10) die vorhanden sind, werden zudem von diversen Usern genutzt. Wenn also jemand mal die Datei offen hat und kurz nicht am PC ist, kommt es vor, dass sich ein anderer User an dem PC einloggt.

Am besten wäre es, wenn das Makro prüft, ob noch eine Mausbewegung innerhalb der Mappe vorgenommen wird. Sobald man auf einen anderen Task springt, soll die Mausbewegung nicht mehr gezählt und die Mappe nach einer bestimmten Zeit deaktiviert werden. Ich befürchte nun jedoch, dass das so nicht bzw nur sehr schwer umsetzbar ist, oder? Zumindest habe ich nichts entsprechendes im Netz gefunden.

Als zweite Variante wäre auch ok, dass er nur prüft, ob Veränderungen vorgenommen werden - innerhalb eines Blattes oder aber der Sprung von einem zum anderen Blatt. Habt ihr da ggf. ein Makro parat, welches ich anpassen kann?

Vielleicht habe ich auch eine Variante vergessen, die viel besser geeignet ist ... ihr habt sicher mehr Erfahrung mit solchen Problemstellungen.


Gruß
Top
#2
Schon mal Google bemüht?

https://www.extendoffice.com/de/document...ivity.html
http://www.hajo-excel.de/vba_datei_schlieszen.htm
Schöne Grüße
Berni
Top
#3
... jetzt mal ernsthaft ... du hast dazu nichts im i-Net gefunden ?

versuch's nochmal ...

'excel datei nach inaktivität schließen'

Wenn nicht in einer Datei geklickt wird, dann wird auch nicht das Workbook_SheetChange Event ausgelöst.
Top
#4
Also ist das mit dem Mauszeiger bewegen nicht möglich - das als Antwort ist doch auch schon was.
Top
#5
Hallöchen,

ein bisschen Bewegung tut's doch auch, oder? Hier mal ein erster Ansatz. Das Makro prüft jede Sekunde, wo auf Deinem Schirm der Mauszeiger steht, und trägt Dir das in A1 und A2 ein. Daneben schreibt es die Position und Abmaße von Excel. Das müsste man noch umrechnen auf die Bildschirmposition, und Du kannst prüfen, wo die Maus zu jeder Sekunde steht. Dazu müsste es noch die Zeit auswerten, wenn die Maus bei Prüfung innerhalb Excel steht. Steht sie außerhalb, wird die Zeit nicht aktualisiert, sodass Du einen zeitvergleich machen kannst und die Datei ggf. schließen ...
Die Periode kann man natürlich noch erweitern und sollte das auch … Ich hab die nur mal zum test so klein gewählt, damit man schneller was sieht Smile Wenn die Datei nach 10 Minuten zugehen soll, reicht sicher ein Minutentakt oder 30 Sekunden …
Wenn so was passt, machen wir weiter Smile

Code:
Option Explicit
Public Declare Function GetCursorPos Lib "user32" (lpPoint As _
   POINTAPI) As Long
Private Type POINTAPI
        x As Long
        y As Long
End Type
Dim a As POINTAPI

Private Sub Test1()
    mousepos
    Application.OnTime Now + TimeValue("00:00:01"), "Test1"
End Sub

Private Sub mousepos()
Dim ret
ret = GetCursorPos(a)
Cells(1, 1) = a.x
Cells(2, 1) = a.y
Cells(1, 2) = Application.Left
Cells(2, 2) = Application.Top
Cells(1, 3) = Application.Left + Application.Width
Cells(2, 3) = Application.Top + Application.Height
End Sub
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top
#6
Hallo,

ich sehe es nicht ganz so wie André. Nur zufällig über die Exceloberfläche gefahren und schon bleibt die Datei offen.
Für mich heißt 'bearbeiten' ... wie bereits errwähnt ... in der Datei klicken ...
Code ist nicht von mir ... gefunden unter http://www.office-loesung.de/ftopic442760_0_0_asc.php

Machbar ist das schon, aber dazu müssen einige Voraussetzungen gegeben sein.

1. Die Systemadministration muss die Ausführung von Makros bzw. das Ändern der Makro-Sicherheiteinstellungen zulassen.

2. Der Benutzer muss die Makroausführung aktivieren, sonst läuft deine Absicht ins Leere. Anders gesagt, er muss zur Aktivierung der Makros dadurch veranlasst werden, dass die Datei ohnedem nicht vernünftig benutzt werden kann.

3. In bestimmten Fällen kann das Schließen trotzdem verhindert werden, z. B. indem eine Zelleingabe begonnen, aber nicht (mit Tab oder Enter) abgeschlossen wird, weil im Eingabemodus kein VBA-Code ausgeführt wird.

Wenn du es trotzdem realisieren willst, füge folgenden Code im Objektmodul DieseArbeitsmappe ein:
Code:
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
End Sub

Private Sub Workbook_Open()
dteCloseTime = Now + TimeSerial(0, 9, 0)
Application.OnTime dteCloseTime, "DoClose"
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 9, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 9, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 9, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub[b]

Der folgende Code gehört in ein allgemeines Modul:
Code:
Option Explicit

Public dteCloseTime As Date, blnCloseNow As Boolean

Public Sub DoClose()
Dim strMsg As String
If blnCloseNow = False Then
  strMsg = "Diese Datei wurde seit 9 Minuten nicht bearbeitet und" & vbCrLf & _
    "wird bei weiterer Inaktivität in 1 Minute geschlossen."
  CreateObject("WScript.Shell").PopUp strMsg, 10, ThisWorkbook.Name, _
    vbOKOnly + vbInformation + vbSystemModal
  blnCloseNow = True
  dteCloseTime = Now + TimeSerial(0, 1, 0)
  Application.OnTime dteCloseTime, "DoClose"
Else
  If Workbooks.Count = 1 Then
    If ThisWorkbook.Saved = False Then
      ThisWorkbook.Save
    End If
    Application.Quit
  Else
    ThisWorkbook.Close True
  End If
End If
End Sub[b]
Nach 9 Minuten erscheint für 10 Sekunden ein PopUp (keine MsgBox, weil die vom Benutzer erst quittiert werden muss), und nach einer weiteren Minute wird die Datei gespeichert und dann geschlossen. Wenn es die einzige geöffnete Excel-Datei ist, wird auch Excel beendet. Nach Auswahl einer anderen Tabelle, Veränderung der Zellauswahl in der aktuellen Tabelle oder natürlich einer Zelleingabe beginnt die Zeit wieder bei Null.
Top
#7
Hallöchen,

Zitat:ich sehe es nicht ganz so wie André. Nur zufällig über die Exceloberfläche gefahren und schon bleibt die Datei offen.

Der Punkt geht noch weiter. Wenn man eine andere Applikation öffnet, die sich über Excel legt, und man macht dort was, ist man auch über Excel...
Man muss bei meinem Ansatz zwei Fälle unterscheiden. Der eine ist, Excel bleibt im Vordergrund, die Maus irgendwo am Schirm ohne weitere Bewegung (Mittagspause). Hier wirken die Zahlen aus dem geposteten Code und die Zeit. Da braucht man eigentlich auch nix umrechnen.

Fall zwei wäre die Aktivierung und Deaktivierung von Excel beim Wechsel in eine andere Applikation. Dafür gäbe es auch was...
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste