Microsoft Excel

Herbers Excel/VBA-Archiv

Automatischer "Logout"

Betrifft: Automatischer "Logout" von: Marcus Kempf
Geschrieben am: 20.11.2014 09:32:41

Hallo,

ich habe mir das folgende Makro zusammen gebastelt, dass dafür sorgen soll, dass nach einer definierten Zeit ab dem letzten Klicken oder Tippen etwas passiert.

Private Type LASTINPUTINFO
  cbSize As Long
  dwTime As Long
End Type
Private Declare PtrSafe Sub GetLastInputInfo Lib "user32" (ByRef plii As LASTINPUTINFO)
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long

'Logout nach X Minuten

Function IdleTime() As Single
  Dim a As LASTINPUTINFO
  a.cbSize = LenB(a)
  GetLastInputInfo a
  IdleTime = (GetTickCount - a.dwTime) / 1000
End Function
Sub Idle_Timer()
    Application.OnTime Now + TimeSerial(0, 1, 0), "Logout"
End Sub

Sub Idle_Timer2()
    Application.OnTime Now + TimeSerial(0, 1, 0), "Logout"
End Sub

Sub Logout()
ActiveWorkbook.Unprotect Passwort_Admin
    Worksheets("Datenbasis").Visible = xlVeryHidden
    Worksheets("Normalschicht").Visible = xlVeryHidden
    Worksheets("Schicht1").Visible = xlVeryHidden
    Worksheets("Schicht2").Visible = xlVeryHidden
    Worksheets("Schicht3").Visible = xlVeryHidden
    Worksheets("Abteilungsleiter").Visible = xlVeryHidden
    Worksheets("Anleitung").Visible = xlVeryHidden
    Sheets("Startseite").Range("A1").Select
Application.CommandBars("Ply").Enabled = False
ActiveWorkbook.Protect Passwort_Admin, Structure:=True
Call Idle_Timer2
End Sub


Sub Logout2()
ActiveWorkbook.Unprotect Passwort_Admin
    Worksheets("Datenbasis").Visible = xlVeryHidden
    Worksheets("Normalschicht").Visible = xlVeryHidden
    Worksheets("Schicht1").Visible = xlVeryHidden
    Worksheets("Schicht2").Visible = xlVeryHidden
    Worksheets("Schicht3").Visible = xlVeryHidden
    Worksheets("Abteilungsleiter").Visible = xlVeryHidden
    Worksheets("Anleitung").Visible = xlVeryHidden
    Sheets("Startseite").Range("A1").Select
Application.CommandBars("Ply").Enabled = False
ActiveWorkbook.Protect Passwort_Admin, Structure:=True
Call Idle_Timer
End Sub

Das Ganze funktioniert soweit auch ganz gut, jedoch wird die 1 Minute nicht richtig eingehalten.

Die Ausführung passiert jeweils bereits nach ~44 Sekunden.

Kann mir das jemand erklären?

Danke im Voraus

Marcus

  

Betrifft: AW: Automatischer "Logout" von: Marcus Kempf
Geschrieben am: 20.11.2014 11:22:01

Hallo nochmal,

ich hatte einen Denkfehler.

Hier die Lösung für alle mit einem ähnlichen Vorhaben:

'In "Diese Arbeitsmappe"
Private Sub Workbook_Open()
Call Idle_Timer
End Sub

'Deklarationsteil eines Modules
Private Type LASTINPUTINFO
  cbSize As Long
  dwTime As Long
End Type
Private Declare PtrSafe(Kann bei Win32 entfallen) Sub GetLastInputInfo Lib "user32" ( _
ByRef plii As LASTINPUTINFO)
Private Declare PtrSafe(Kann bei Win32 entfallen) Function GetTickCount Lib "kernel32" () _
 As Long

'Logout nach 15 Minuten

Function IdleTime() As Single
  Dim a As LASTINPUTINFO
  a.cbSize = LenB(a)
  GetLastInputInfo a
  IdleTime = (GetTickCount - a.dwTime) / 1000 'Idletime in Sekunden
End Function

Sub Idle_Timer()
    If IdleTime >= 900 Then 'Vergleich Idletime mit Zeitvorgabe in Sekunden
       'Was soll passieren
    End If
Application.OnTime Now + TimeValue("0:0:1"), "Idle_Timer2" 'Wiederholungsprüfung nach 1 Sekunde
End Sub

Sub Idle_Timer2()
    If IdleTime >= 900 Then 'Vergleich Idletime mit Zeitvorgabe in Sekunden
       'Was soll passieren
    End If
Application.OnTime Now + TimeValue("0:0:1"), "Idle_Timer" 'Wiederholungsprüfung nach 1 Sekunde
End Sub