title image


Smiley Re: Fortschrittsanzeige in Excel97
Hallo Reinhard,nachfolgend der Code fuer die Anzeige einer Progressbar in einer Userform mit Image1, Image2, Label1 (ohne Nutzung von DLL oder OCX). Damit sollte man von den jeweils installierten Programmzusaetzen unabhaengig sein.Die Progressbar wird mit dem Makro "UserForm_Click" aufgerufen, und muesste auf die jeweiligen Randbedingungen angepasst werden.Der Code "Sub UserForm_QueryClose" stellt sicher, das die Ausfuehrung des Makros "UserForm_Click" vollstaendig abgearbeitet wird.REM Excel & ProgressBar:Option ExplicitRem ProgressBar for Excel97.Rem Required: Userform with Image1, Image2, Label1.Const conImage100 As Integer = 200 ' = 100% width of the progressbar (Image1)Dim intListMax As IntegerDim intI As IntegerDim intIndex As IntegerDim intCounter As IntegerDim intPercent As IntegerDim dblProgress As DoubleDim dblPercentColor As Double Private Sub UserForm_Click() intListMax = 5000 'amount of total steps for the progress bar intPercent = 5 'update the progress bar in 5% steps dblPercentColor = 0.45 'change the label color if beyond this value intCounter = 1 With Me For intI = intIndex To intListMax - 1 Step 1 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 = FalseEnd Sub Private 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 Else Cancel = False End IfEnd SubIn der Hoffnung, dieses hilft Dir weiter,viele GruesseNorbert

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: