Office: (Office 2019) Excel inaktiv

Edgar Basler · 13. Oktober 2020

Guten Tag

Heute kam ein Kollege mit einer für mich ungewöhnlichen Fragestellung auf mich zu. Es gibt Kollegen, die vergessen Excel nach Beendigung der Aufgaben zu schließen. Somit können andere Kollegen mit dieser Datei nicht mehr arbeiten. Ganz mißlich wird es, wenn der Kollege auch noch nach Hause geht und der PC gesperrt ist.

Sein Wunsch:

Wenn mit der Excel-Datei eine Zeit "x" nicht mehr gearbeitet wird, soll die Datei gespeichert und geschlossen werden. Geht so etwas per VBA?

Kann mir da jemand helfen und einen Beispiel Code senden?

Ganz lieben Dank

:)

EarlFred · 14. Oktober 2020

Geht so etwas per VBA[Google]?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ja, geht! Versuch's doch einfach mal. *wink.gif*

Du bist nicht der erste mit dem Wunsch - Musterlösungen findest du bereits im Netz. Da kommen dann sicher noch Detailfragen: Für welche Mappen soll das gelten? Was definierst du als "Inaktivität" bzw. "Aktivität"?

Wenn man mit solchen Dateien arbeitet, kann man sich auch andere Konzepte ausdenken (neben Datenbanken): Die Mappen auf dem Server dienen nur als "Datenspeicher", jeder Anwender hat auf seinem Rechner eine eigene Mappe, die nur als Schnittstelle dient (also quasi Front-End / Back-End in Excelmanier).

Alles eine Frage des eigentlichen Ziels.

KlausKleber · 14. Oktober 2020

Hi, kommt bei uns in der Firma auch öfter vor.

Die werden dann einfach von der IT (mir) geschlossen wenn der jenige bereits aus dem Haus ist.

Gruß
Klaus

EarlFred · 14. Oktober 2020

Quick&Dirty:
Code:

Option Explicit

Private WithEvents xlsAppEvents As Excel.Application
Private objDic As Object

Const cSecondsInactive As Long = 600 'Zeit in Sekunden

'#############################################
'Initialisierung der Event-Überwachung der APP
'sowie des Datenspeichers
'#############################################
Private Sub Workbook_Open()
Set xlsAppEvents = Me.Application
Set objDic = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set objDic = Nothing
Set xlsAppEvents = Nothing
End Sub

'#############################################
'Registrierung von Workbooks
'#############################################
Private Sub xlsAppEvents_WorkbookOpen(ByVal Wb As Workbook)
If Not Wb.IsAddin Then
Call RegisterWB(wbName:=Wb.Name)
End If
End Sub
Private Sub xlsAppEvents_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
If Not Wb.IsAddin Then
Call UnRegisterWB(wbName:=Wb.Name)
End If
End Sub

'#############################################
'Ereignisse, die als Aktivität gewertet werden
'#############################################
Private Sub xlsAppEvents_SheetActivate(ByVal Sh As Object)
Call SetTimer(wbName:=Sh.Parent.Name)
End Sub
Private Sub xlsAppEvents_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Call SetTimer(wbName:=Sh.Parent.Name)
End Sub
Private Sub xlsAppEvents_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call SetTimer(wbName:=Sh.Parent.Name)
End Sub
Private Sub xlsAppEvents_WorkbookActivate(ByVal Wb As Workbook)
Call SetTimer(wbName:=Wb.Name)
End Sub

'#############################################
'Functions
'#############################################
Private Sub RegisterWB(ByRef wbName As String)
objDic(wbName) = 0
End Sub
Private Sub SetTimer(ByRef wbName As String, Optional ByRef blnDelete As Boolean = False)
If objDic.Exists(wbName) Then
If objDic(wbName) > 0 Or blnDelete Then
Call xlsAppEvents.OnTime( _
EarliestTime:=objDic(wbName), _
Procedure:="'DieseArbeitsmappe.CloseWBByTimer """ & wbName & """'", _
Schedule:=False)
End If
If Not blnDelete Then
objDic(wbName) = Now() + TimeSerial(0, 0, cSecondsInactive)
Call xlsAppEvents.OnTime( _
EarliestTime:=objDic(wbName), _
Procedure:="'DieseArbeitsmappe.CloseWBByTimer """ & wbName & """'", _
Schedule:=True)
End If
End If
End Sub
Private Sub UnRegisterWB(ByRef wbName As String)
Call SetTimer(wbName:=wbName, blnDelete:=True)
Call objDic.Remove(wbName)
End Sub

Public Function CloseWBByTimer(ByRef wbName As String) As Boolean
Call xlsAppEvents.Workbooks(wbName).Close(SaveChanges:=True)
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der Code gehört in eine neue Arbeitsmappe, dort in das vorhandene Klassenmodul "DieseArbeitsmappe" (bei anderssprachiger Version im Code oder den Modulnamen anpassen) und die Mappe wird als Add-In gespeichert in einem Pfad, deren Dateien Excel beim Start automatisch öffnet.
(z. B. sollte per Default aktiv sein: C:\Users\{DeinUserName}\AppData\Roaming\Microsoft\Excel\XLSTART)

Was als Aktivität anerkannt wird, ist im Code kommentiert, weitere Events kannst du nach vorgegebenem Muster ergänzen.

Edgar Basler · 15. Oktober 2020

Herzlichen Dank,

Ich werde dies mal für meinen Kollegen ausprobieren.

EarlFred · 27. Oktober 2020

Ist es vermessen, nach einer etwas umfassenderen Rückmeldung mit deinen Erfahrungen mit meinem Code zu fragen, den ich extra für dich geschrieben habe?

Edgar Basler · 28. Oktober 2020

Ich möchte mich nochmals ganz persönlich bei dir für deine Bemühung bedanken.
Es lag zum einen daran, daß ich erkrankt war und zum anderen, daß meine persönlichen Fähigkeiten doch recht beschränkt sind. Ich dachte, daß es quasi ein Event gibt und daß man nicht so vieles "abfangen" muß.

Deshalb nochmals Danke an dich und einen schönen Tag

Office: (Office 2019) Excel inaktiv

Excel inaktiv

Excel inaktiv

Excel inaktiv

Excel inaktiv - Similar Threads - Excel inaktiv

x-y-Diagramm mit Datum(x-Achse) und Uhrzeit(y-Achse)

Diagramm in Excel

Alle Checkboxen anwählen und definieren

nur x Anzahl an Werten aus spalte anzeigen

sVerweis Blattübergreifend verwenden

Benutzerdefinierte Farben In Excel wie in Powerpoint via thmx

Transportkosten mit zwei Vergleichen