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