%-Fortschritt des Macroablaufes im Popup darst. !?
10.08.2003 05:32:48
Kabas Enrico
Habe gestern in einem anderen Form unten stehenden Code gefunden -->
Ich habe die erforderlichen 2Module und 2Userformen angelegt, aber ich bekomme da gewünsche %-Fortschritt-Popup nicht zu sehen. Wie rufe ich es auf ?
Danke
Enrico
Bei länger dauernden Ausführungen per Makro ist es empfehlenswert, den Ablauf des Vorgangs visuell anzuzeigen. Dies kann z.B. mit Meldungen in der Statusleiste oder wie in diesem Beispiel mit einem Fortschrittsbalken auf einer UserForm geschehen. Als besonderen Leckerbissen wird hier auf der Start-Userform aufgezeigt, wie ein blinkender CommandButton ohne Timer realisiert werden kann.
'------------------- UserForm - frmStart.frm --------------------
Option Explicit
Private Sub UserForm_Activate()
Me.cmdStarten.Default = True
Me.cmdBeenden.Cancel = True
flagStart = True
Call modStart.StartButtonBlinken
End Sub
Private Sub cmdStarten_Click()
Call modStart.Beenden_StartButtonBlinken
Me.Hide
frmFortschritt.Show
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, _
CloseMode As Integer)
flagStart = False
Call modStart.Beenden_StartButtonBlinken
End Sub
'--------------------- Modul - modStart.bas ---------------------
Option Explicit
Public flagStart As Boolean
Public zeit As Date
Sub Starten()
frmStart.Show
End Sub
Sub StartButtonBlinken()
Const btnColorDefault As Long = &H8000000F
Const btnColorHellGrau As Long = &HE0E0E0
If flagStart = False Then Beenden_StartButtonBlinken: Exit Sub
zeit = Now + TimeValue("00:00:01")
With frmStart.cmdStarten
If .BackColor = btnColorDefault Then
.BackColor = btnColorHellGrau
Else: .BackColor = btnColorDefault
End If
End With
With frmStart.lblDemo
If .Left = 6 Then .Left = 31 Else .Left = 6
End With
Application.OnTime zeit, "StartButtonBlinken"
DoEvents
End Sub
Sub Beenden_StartButtonBlinken()
On Error Resume Next
Application.OnTime zeit, "StartButtonBlinken", _
schedule:=False
End Sub
'---------------- UserForm - frmFortschritt.frm -----------------
Option Explicit
Private Sub UserForm_Initialize()
Me.StartUpPosition = 2
Me.cmdOKCancel.Default = True
Me.cmdOKCancel.Cancel = True
End Sub
Private Sub UserForm_Activate()
flagAbbrechen = False
Me.lblFortschritt.Width = 0
Me.lblFortschrittTxt.Caption = _
"Die Daten werden in die Tabelle eingetragen. " & _
vbCrLf & "Bitte warten..."
Call modFortschritt.Zufallszahlen
If flagAbbrechen Then
Me.lblFortschrittTxt.Caption = _
"Der Vorgang wurde abgebrochen !"
Else
Me.lblFortschrittTxt.Caption = _
"Der Vorgang wurde erfolgreich abgeschlossen !"
End If
byebye:
Me.frameFortschritt.Visible = False
With Me.cmdOKCancel
.Caption = "OK"
.Accelerator = "O"
End With
End Sub
Private Sub cmdOKCancel_Click()
flagAbbrechen = True
If cmdOKCancel.Caption = "OK" Then
Unload Me
frmStart.Show
End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, _
CloseMode As Integer)
If Not flagAbbrechen Then Cancel = True
If CloseMode = vbFormControlMenu Then Cancel = True
End Sub
'------------------ Modul - modFortschritt.bas ------------------
Option Explicit
Public flagAbbrechen As Boolean
Sub Zufallszahlen()
Dim maxZeilen As Integer
Dim maxSpalten As Integer
Dim z As Integer
Dim s As Integer
Dim zaehler As Integer
Dim fortschritt As Single
Dim antwort As Long
maxZeilen = 500
maxSpalten = 25
zaehler = 1
Worksheets("Tabelle1").Activate
Range("A1").Select
ActiveSheet.UsedRange.Delete
For z = 1 To maxZeilen
For s = 1 To maxSpalten
Cells(z, s) = Int(Rnd * 1000)
zaehler = zaehler + 1
Next s
fortschritt = zaehler / (maxZeilen * maxSpalten)
Call FortschrittUpdate(fortschritt)
If flagAbbrechen Then
antwort = MsgBox("Wollen Sie den Vorgang wirklich " & _
"abbrechen?", vbYesNo + vbDefaultButton2 + _
vbQuestion, Title:="Excel - Fortschrittsleiste")
If antwort = vbYes Then
Worksheets("Tabelle1").Activate
ActiveSheet.UsedRange.Delete
Exit Sub
ElseIf antwort = vbNo Then
flagAbbrechen = False
End If
End If
Next z
End Sub
Sub FortschrittUpdate(fortschritt As Single)
With frmFortschritt
.lblFortschritt.Caption = Format(fortschritt, "0 %")
.lblFortschritt.Width = fortschritt * (.frameFortschritt.Width)
End With
DoEvents
End Sub