Progress Bar

W

whitethomas12

I am 4 sub procedures and it takes awhile to process everything. All
I need is a basic progress bar to show the user the status.

So far I have a created a basic user form with two lables (1 has a
width = to 0). How can I have the status bar popup once the user
presses the start button and then update in different places in my
code rather than trying to create a loop for it.

Can someone post sample code for this

Thank you for all of your help
 
W

whitethomas12

I use the application.statusbar to give messages to the user.

But if you want a progress bar, you can start here:

John Walkenbach's site:http://www.j-walk.com/ss/excel/tips/tip34.htm

I have tried this site and many others just like it and none of them
fit my situation. I didn't expect this to be too difficult, but it
seems to be very difficult. I cannot find anything on the web that
will will help. I tried modifing all of the example codes but all
have failed and has caused my excel to lockup in many cases.

Has anyone done this before??

Thank you for all of your help
 
D

Dave Peterson

I don't use it very often--and if I need it, I start on John's page.

I'm pretty low tech. I'll just use application.statusbar.
 
T

Tim Zych

What's not working? Using a custom progressbar in a userform is no
cakewalk...actually I find them to be kind of unusable, since they basically
take away the notion of modular programming and bind otherwise independent
processes directly to a userform. They have to call home to mommy all the
time and let her know what they done. Not always as easy as it sounds...what
is not working with your trial?


--
Tim Zych
SF, CA

I use the application.statusbar to give messages to the user.

But if you want a progress bar, you can start here:

John Walkenbach's site:http://www.j-walk.com/ss/excel/tips/tip34.htm

I have tried this site and many others just like it and none of them
fit my situation. I didn't expect this to be too difficult, but it
seems to be very difficult. I cannot find anything on the web that
will will help. I tried modifing all of the example codes but all
have failed and has caused my excel to lockup in many cases.

Has anyone done this before??

Thank you for all of your help
 
R

ryguy7272

I struggled with this a short time ago; below is my solution:

Create a UserForm called:
frmProgress
and inside this place the following caode:

Private Sub UserForm_Initialize()
UserCancelled = False
End Sub

On the UserForm have a Label called: lblMsg1
Also, have a label called lblMsg2
Finally, have an Image called: imgProgFore


Then, create a modeule and place this code within:
Sub ProgBar()

Dim PB As clsProgBar
Set PB = New clsProgBar

With PB

..Title = "Progress Bar"
..Caption1 = "Executing; please wait. This may take a short while..."
..Show
DoEvents


End With

PB.Progress = 5

....your code

PB.Progress = 10

....your code
....etc.

PB.Progress = 90

....your code

PB.Progress = 95

....your code

PB.Progress = 100
Application.Speech.Speak "Finished with Report" 'This is optional; nice touc

PB.Finish
End Sub


After all this, you have to create a Class Moduel and place this code within:
Public DisableCancel As Boolean
Public Title As String

Private nVersion As Integer

Private strStatus As String
Private strStat1 As String
Private strStat2 As String
Private strStat3 As String
Private strProgress As String

Property Let Caption1(strCaption As String)

If nVersion < 9 Then

strStat1 = strCaption
UpdateStatus

Else

#If VBA6 Then

frmProgress.lblMsg1.Caption = strCaption
DoEvents

#End If

End If

End Property

Property Let Caption2(strCaption As String)

If nVersion < 9 Then

strStat2 = strCaption
UpdateStatus

Else

#If VBA6 Then

frmProgress.lblMsg2.Caption = strCaption
DoEvents

#End If

End If

End Property

Property Let Caption3(strCaption As String)

If nVersion < 9 Then

strStat3 = strCaption
UpdateStatus

Else

#If VBA6 Then

frmProgress.lblMsg3.Caption = strCaption
DoEvents

#End If

End If

End Property

Sub Finish()

If nVersion < 9 Then

Application.StatusBar = ""
Application.StatusBar = False

Else

#If VBA6 Then

Unload frmProgress

#End If

End If

End Sub

Sub Hide()

If nVersion < 9 Then

Application.StatusBar = ""
Application.StatusBar = False

Else

#If VBA6 Then

frmProgress.Hide

#End If

End If

End Sub

Property Let Progress(nWidth As Integer)
Dim nProgress As Integer

If nVersion < 9 Then

strProgress = CStr(nWidth)
UpdateStatus

Else

#If VBA6 Then

If nWidth > 100 Then nWidth = 100

If nWidth < 0 Then nWidth = 0

With frmProgress.imgProgFore

.Width = 200 - Int(nWidth * 2)
.Left = 12 + Int(nWidth * 2)

End With

DoEvents

#End If

End If

End Property

Sub Reset()

If nVersion < 9 Then

Application.StatusBar = ""
Application.StatusBar = False

Else

#If VBA6 Then

Title = ""
frmProgress.lblMsg1.Caption = ""
frmProgress.lblMsg2.Caption = ""
frmProgress.lblMsg3.Caption = ""
DisableCancel = False

#End If

End If

End Sub

Sub Show()

If nVersion < 9 Then

'probably best to leave the title out of this

Else

#If VBA6 Then

With frmProgress

If DisableCancel = True Then

.Width = 228
'.cmdCancel.Enabled = False

End If

.Caption = Title
.Show vbModeless

End With

#End If

End If

End Sub

Private Sub Class_Initialize()

nVersion = Val(Application.Version)

End Sub

Private Sub Class_Terminate()

If nVersion < 9 Then Application.StatusBar = False

End Sub

Private Sub UpdateStatus()
Dim strStatus As String

strStatus = strStat1
If strStat2 <> "" Then strStatus = strStatus & ", " & strStat2
If strStat3 <> "" Then strStatus = strStatus & ", " & strStat3

If strProgress <> "" Then strStatus = strStatus & ", " & strProgress & "%"

Application.StatusBar = strStatus

End Sub

Regards,
Ryan--


See this for more:
http://www.microsoft.com/office/com...=en-us-excel&lang=en&cr=US&sloc=en-us&m=1&p=1
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top