title image


Smiley Re: Fortschrittsanzeige in Excel97, fuer's Forum
Hallo Reinhard,das gepostete Makro ist aus einer von mir erstellten Userform,in der ich den Berechnungsfortschritt einer recht komplizierten Funktion anzeigen wollte.Um dieses nun ausserhalb einer Userform anwenden zu wollen,bedarf es einem Module, welches dieses steuert.Ich habe das Ganze nochmal ueberarbeitet, damit es auch so genutzt werden kann.Dabei ist jedoch zu beachten, dass die Funktion oder das Sub welchesabgearbeitet werden soll, innerhalb der "Progressbar"-Userform aufgerufen werden muss.Mit: sub .....() for i=1 to 12345 userform.show (Fortschrittsanzeige) next i end subfunktioniert es leider nicht, da hierbei die Userform immer wieder neu (mit ihrem Ursrungszustand) angezeigt werden wuerde.Vielmehr wird die UserForm nur einmal geladen, ueber Initialize werden dieGrundeinstellungen vorgenommen und die Userform immer nur entsprechend aktualisiert.Also mehr in der Form: sub Progress() userform.show for i=1 to 12345 call Function oder Sub XYZ userform.repaint next i end subAnstelle von Userform.Repaint habe ich DoEvents verwandt.Damit wird Windows "gezwungen" die Userform neu zu zeichen,ohne das die Userform wie bei Repaint flimmert.Ich hoffe die angehaengte Beispieldatei traegt etwas mehr zum Verstaendnis bei.Einfach das Makro "MyProgress" aufrufen.Anzumerken waehre eventuell noch, dass sich die Ausfuehrung eines Makros mitder Nutzung dieser Fortschrittsanzeige wesentlich verlangsamt, da zusaetzlich zu der eventuell langwierigen Aktionauch immer noch diese Userform aktualisiert werden muss.Also besser nur dort verwenden, wo man sowieso schon fuer Ewigkeiten nur die "Sanduhr" sieht.Application.Statusbar ist oftmals die bessere Alternative.Viele GruesseNorbertxxxxxxxxxxxxxxxxxxxxxxxxxxxNachfolgend der Code:Rem Module1:Option ExplicitPublic intListMax As IntegerPublic intPercent As IntegerSub MyProgress() intListMax = 2000 'as integer max. 32767 steps for the progress bar intPercent = 5 'progressbar update all (intPercent)% Load UserForm1 UserForm1.Show Unload UserForm1End SubSub MyAction(Counter) ActiveCell.Offset(Counter, 0) = Counter + 1End Sub UserForm1:Option ExplicitRem ProgressBar for Excel97.Rem Required: Userform with Image1, Image2, Label1.Const conImage100 As Integer = 200 ' = 100% width of the progressbar (Image1)Dim intI As IntegerDim intIndex As IntegerDim intCounter As IntegerDim dblProgress As DoubleDim dblPercentColor As DoublePrivate Sub UserForm_Activate() dblPercentColor = 0.45 'change the label color if beyond this value intCounter = 1 On Error GoTo Errorhandle With Me .Repaint For intI = intIndex To intListMax - 1 Step 1 Rem The Function or Sub to be used, Rem must be placed here. e.g.: Call MyAction(intI) Rem Continue with the progressbar. dblProgress = (intI + 1) / intListMax Application.StatusBar = "Progress: " & Format(dblProgress, "0.0%") .Label1.ForeColor = RGB(0, 0, 0) 'label is Black If dblProgress * 100 >= intPercent * intCounter Then .Image1.Width = dblProgress * conImage100 .Label1 = Format(dblProgress, "0%") If dblProgress >= dblPercentColor Then .Label1.ForeColor = RGB(255, 255, 0) 'label is Yellow End If 'The DoEvents statement is responsible for the form updating DoEvents intCounter = intCounter + 1 End If Next intI 'set the 100% progress bar dblProgress = 1 .Image1.Width = dblProgress * conImage100 .Label1 = Format(dblProgress, "0%") .Repaint End With Application.StatusBar = False Me.Hide Exit SubErrorhandle:Rem In case an error occured the variable dblProgress = 1 'is set to 1, ' in order the Userform can be closed ' by clicking the X button. On Error Resume Next With Me .Label1 = "E R R O R occured" .Label1.ForeColor = RGB(255, 0, 0) 'label is Red .Repaint End WithEnd SubPrivate Sub UserForm_Initialize() Rem Image1 = Progress image 'size and position is used for: Rem Image2 = Progress image frame Rem Label1 = Progress percentage With Me .Caption = "Progress" .Image1.BackColor = RGB(0, 0, 255) 'Blue .Image1.Height = 16 .Image1.Left = 16 .Image1.Top = 12 .Image1.Width = 0 .Label1.Font.Bold = True .Label1.ForeColor = RGB(0, 0, 0) 'Black .Label1.Height = Image1.Height .Label1.Left = Image1.Left .Label1.TextAlign = fmTextAlignCenter .Label1.Top = Image1.Top + 2 .Label1.Width = conImage100 .Image2.Height = Image1.Height + 2 .Image2.Left = Image1.Left - 1 .Image2.SpecialEffect = fmSpecialEffectSunken .Image2.Top = Image1.Top - 1 .Image2.Width = conImage100 + 2 .Height = 60 .Width = conImage100 + 2 * (Image1.Left + 1) End WithEnd SubPrivate Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If dblProgress 1 Then Cancel = True 'Userform cannot be closed. Else Cancel = False 'Userform can be closed. End IfEnd Sub----- Original Message -----From: To: Sent: Monday, March 13, 2000 5:57 PMSubject: Fortschritts-anzeigeLieber Herr Koehler,zuerst einmal vielen Dank für das Makro.Es stellt sich nun für mich die Frage, wie ich die Anzeige aufrufe und mitLeben, einer Anzeige farblich und mit %-Werten fülle...ich stelle mir das in etwa so vor:sub .....()for i=1 to 12345userform.show (Fortschrittsanzeige)next iend sub.... klappt aber nicht.Rufe ich die userform auf (userform1.show) dann erscheint sie auch, aber esändert sich keine AnzeigeSteht auch Mitten im vertieften Teil "Label1"Vielen Dank für die HilfeReinhard Busse

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: