AW: Fortschrittsbalkenmakro anpassen
09.06.2011 17:42:39
CitizenX
Hallo,
wenn es denn doch der Fortschrittsbalken sein soll dann so:
Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub ShowDialog()
Load ProgressDlg
ProgressDlg.Show
'--- Bildschirmaktualisierung aus
Application.ScreenUpdating = False
'--- Ergebnis auf Zelle C4 in Zelle C3 kopieren und formatieren
'ActiveSheet.Unprotect Password:=""
Range("C4").Select
Selection.Copy
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A3").Select
'ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingRows:=True
End Sub
Sub Main()
Dim i As Long, tot As Long
tot = 500000
ProgressDlg.Caption = "Ergebnis wird berechnet, bitte warten ..."
For i = 1 To tot
If i Mod 5 = 0 Then ProgressBar i / tot
' do something
Next i
Unload ProgressDlg
End Sub
Sub ProgressBar(PctDone As Single)
With ProgressDlg
.lblDone.Width = PctDone * (.lblRemain.Width - 2)
.lblPct.Caption = Format(PctDone, "0%")
Select Case PctDone
Case 0.76
Sleep 1500
Case 0.98
Sleep 500
End Select
End With
'The DoEvents statement is responsible for the form updating
DoEvents
End Sub
Obwohl mir die Sinnhaftigkeit auch nicht erschließt,muss es ja auch nicht :-))
Grüße
Steffen