Hallo,
ok prima, der erste Punkt lässt sich noch machen, füg dazu wieder den geänderten Code in die drei Module ein, bei den anderen beiden Punkten wird aber die Luft (...zumindest für mich...) dünn, Du könntest versuchen, wenn bei einem Lockscreen VBA nicht mehr läuft, den Task abzuschießen das ginge aber wohl nur mit VB.NET oder VBScript, ebenso löst das Scrollen in Excel leider keine Event aus, könnte man vielleicht allenfalls über VB.NET abgreifen...
' **********************************************************************
' Modul: UserForm1 Typ: Userform
' **********************************************************************
Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliSeconds As Long)
Private mobjProgressBar As MSComctlLib.ProgressBar
Private mdtmTime As Date
Private mblnInit As Boolean
Private Sub CommandButton1_Click()
Call Application.OnTime(EarliestTime:=mdtmTime, _
Procedure:="prcTimer", Schedule:=False)
mblnInit = False
Call Hide
Call Application.OnTime(EarliestTime:=Now + TimeSerial(0, 0, GC_TIME_SEC), _
Procedure:="prcTimer")
End Sub
Private Sub UserForm_Activate()
Dim lngIndex As Long
If mobjProgressBar Is Nothing Then
Set mobjProgressBar = Controls.Add(bstrProgID:="MSComctlLib.ProgCtrl.2", _
Name:="ProgressBar1", Visible:=True)
With mobjProgressBar
.Left = 20
.Top = 20
.Width = 200
.Height = 30
.Max = 10
.Min = 0
.Value = 0
End With
With CommandButton1
.Width = 100
.Height = 20
.Top = mobjProgressBar.Top + mobjProgressBar.Height
.Left = mobjProgressBar.Left
.Caption = "Cancel_Close"
.BackColor = &H9400D3
End With
End If
mdtmTime = Now + TimeSerial(0, 0, 10)
Call Application.OnTime(EarliestTime:=mdtmTime, Procedure:="prcTimer")
With mobjProgressBar
For lngIndex = .Min To .Max
If Not Visible Then Exit For
.Value = lngIndex
Caption = "Datei wird geschlossen in " & _
.Max - lngIndex & " Sec"
DoEvents
Call Sleep(1000&)
Call Repaint
Next
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel = CloseMode <> vbFormCode
End Sub
Private Sub UserForm_Terminate()
Call Application.OnTime(EarliestTime:=mdtmTime, _
Procedure:="prcTimer", Schedule:=False)
Set mobjProgressBar = Nothing
End Sub
Friend Property Get prpblnInit() As Boolean
Let prpblnInit = mblnInit
End Property
Friend Property Let prpblnInit(ByVal pvblnInit As Boolean)
Let mblnInit = pvblnInit
End Property
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Klassenmodul der Arbeitsmappe
' **********************************************************************
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Static sblnTerminate As Boolean
If Not (ReadOnly Or sblnTerminate) Then
Call Unload(Object:=UserForm1)
sblnTerminate = True
End If
End Sub
Private Sub Workbook_Open()
If Not ReadOnly Then _
Call Application.OnTime(EarliestTime:=Now + TimeSerial(0, 0, GC_TIME_SEC), Procedure:="prcTimer")
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Standardmodul
' **********************************************************************
Option Explicit
Option Private Module
Public Const GC_TIME_SEC As Integer = 30
Public Sub prcTimer()
With UserForm1
If .prpblnInit Then
Call ThisWorkbook.Save
Call Application.Quit
Else
.prpblnInit = True
Call .Show
End If
End With
End Sub
Gruß,
|