Progress Indicator

R

Rob Hargreaves

Hi I need to find a simple to use progress indicator for excel. I cant use
one which requires a dll or any references.

cpearson has a nice looking one but that does!!

jwalks example only works in some of my code. The loops are quite tight in
the example I want to use one with and it is part of an automated task
between excel and word.

Any suggestions would be great. Graphical ones would be better on a form
which updated an indicator or progress bar whilst the code was being
executed.

(The current code takes 1/2 hour to finish)

Thanks for any help,

Rob
 
G

Greg Wilson

I have two versions of a progress indicators. One is simple (which I
recomment) and the other is complex. Both are constructed of grouped shape
objects (native) and have a 3D appearance similar to a text box embedded in a
user form absent the caption bar.

The complex one was developed for a colleague to monitor a very long,
multiphase test process. It can be made huge so it can easily be seen from
outside the room. It allows for text messages and the band colour can be
adjusted corresponding to the different phases. At the end it is destroyed by
setting the Kill argument to True. As things typically go in my life, the
colleague left us and we no longer do this type of testing, so it never got
used.

The simple one can be made very compact and only supports a band. Your code
simply specifies the band size (%). It automatically self-destructs at 100%.
The 3D graphics is a personal touch. You need to paste the code to a code
module. Arguments are as follows:

ProgressBar(Val As Variant, Optional Size, Optional Left, Optional Top)

On first call the PB is created after which the Size, Left and Top arguments
are ignored. An example of calling it after creation:

ProgressBar 25

If interested, I can post the code.

Regards,
Greg
 
R

Roy Wagner

Rob,

This one is kind of crude, but here goes...
Test this in a new workbook and tweak as you see fit.
Add a command button on the right side of sheet 1 and paste the code below
into its click event.

It is a series of nested for next loops that generates 1 million trips on
the inner loop. It only takes a few seconds to run through on my 2 year old
machine.

On sheet 1, type "95" in cell C2 and "Percent Complete" in cell D2.

Select cell C2 and add a horizontal bar chart to sheet 1. Disable the
automatic scaling otherwise the scale will change as the percent rises. I
stripped mine down so there are no axis markings or title etc. I also resized
it into a narrow rectangle. You can play around with the asthetics. It's not
as pretty as an active x control, but it's simple enough to do. I have a
similar project where I create a written report in word based on data in a
spreadsheet. It takes a couple of minutes to run through and I also wanted
progress bar. Thanks for the kick in the pants to get one figured out. After
I cut the grass ;) I will see if I can't get a text box in a user form to do
the same thing. It would undoubtedly look nicer.

You will have to figure out the best way to increment the percentage in your
own code. Shouldn't be a big deal.


Dim a As Integer, b As Integer, c As Integer
Dim d As Integer, e As Integer, f As Integer
Dim x As Long
Dim TotalRecords As Long
Dim PercentageEvaluated As Double
Dim Progress As Integer

TotalRecords = 10 ^ 6 'used as the basis of 100% - 6 loops of 10 trips
Cells(2, 3).Value = 0 'reset graph to 0
Worksheets(1).ChartObjects(1).Activate 'select chart to work on it
For a = 1 To 10
For b = 1 To 10
For c = 1 To 10
For d = 1 To 10
For e = 1 To 10
For f = 1 To 10
x = x + 1
Next
Next
Next
PercentageEvaluated = x / TotalRecords ' total between 0 and 1
Progress = Int(PercentageEvaluated * 100) 'convert to 0-100
Cells(2, 3).Value = Progress 'update charts source data
With ActiveChart 'without this, no updates till procedure is
completed
.Refresh 'the chart
End With
Next
Next
Next

f = MsgBox(Format(x, "#,#") + " items processed.", vbInformation,
"Processing Complete!")

Roy
 
T

Tom Ogilvy

Why do you say j-walks only works in some of your code.

What is the problem. What do "tight loops" have to do with updating a
progress bar? Seems like a mod function would clear that up and a doevents.
 
R

RB Smissaert

What is wrong with the progressbar control that comes with Excel?
Just put it on a form and set it's value in the loop. These values have to
be between 0 and 100.
Can't be simpler and I never found any problem with them. I am not sure
though if it is in Excel
versions below 9.

RBS
 
R

Rob Hargreaves

Greg,

I am intersted in seeing the code for your progress meters.

Thanks
Rob
 
R

Rob Hargreaves

thanks Roy
Roy Wagner said:
Rob,

This one is kind of crude, but here goes...
Test this in a new workbook and tweak as you see fit.
Add a command button on the right side of sheet 1 and paste the code below
into its click event.

It is a series of nested for next loops that generates 1 million trips on
the inner loop. It only takes a few seconds to run through on my 2 year
old
machine.

On sheet 1, type "95" in cell C2 and "Percent Complete" in cell D2.

Select cell C2 and add a horizontal bar chart to sheet 1. Disable the
automatic scaling otherwise the scale will change as the percent rises. I
stripped mine down so there are no axis markings or title etc. I also
resized
it into a narrow rectangle. You can play around with the asthetics. It's
not
as pretty as an active x control, but it's simple enough to do. I have a
similar project where I create a written report in word based on data in a
spreadsheet. It takes a couple of minutes to run through and I also wanted
progress bar. Thanks for the kick in the pants to get one figured out.
After
I cut the grass ;) I will see if I can't get a text box in a user form to
do
the same thing. It would undoubtedly look nicer.

You will have to figure out the best way to increment the percentage in
your
own code. Shouldn't be a big deal.


Dim a As Integer, b As Integer, c As Integer
Dim d As Integer, e As Integer, f As Integer
Dim x As Long
Dim TotalRecords As Long
Dim PercentageEvaluated As Double
Dim Progress As Integer

TotalRecords = 10 ^ 6 'used as the basis of 100% - 6 loops of 10 trips
Cells(2, 3).Value = 0 'reset graph to 0
Worksheets(1).ChartObjects(1).Activate 'select chart to work on it
For a = 1 To 10
For b = 1 To 10
For c = 1 To 10
For d = 1 To 10
For e = 1 To 10
For f = 1 To 10
x = x + 1
Next
Next
Next
PercentageEvaluated = x / TotalRecords ' total between 0 and 1
Progress = Int(PercentageEvaluated * 100) 'convert to 0-100
Cells(2, 3).Value = Progress 'update charts source data
With ActiveChart 'without this, no updates till procedure is
completed
.Refresh 'the chart
End With
Next
Next
Next

f = MsgBox(Format(x, "#,#") + " items processed.", vbInformation,
"Processing Complete!")

Roy
 
R

Rob Hargreaves

What would the module function contain and what are the loops you talk of?

:->

Rob
 
P

Peter T

Well I'll be blowed, never knew about that.

In my dual XL97 / XL2K system I have

Microsoft ProgressBar Control, version 6.0(SP6)
in - \System\MSCOMCTL32.OCX

Microsoft ProgressBar Control, version 5.0(SP2)
in - \System\COMCTL32.OCX

Both work in both my XL97 & XL2K

It'd sure be useful to know if these controls exist in all user systems,
which if one but not both, and whether any differences in the SP' could be a
problem.

Rob - Right click the forms toolbox dialog.

Regards,
Peter T
 
R

Roy Wagner

Indeed. It's not the fanciest progress bar out there, but it's easy enough to
use. I like it. Didn't realize it was there. I also have Excel 9 (2K). I was
able to set up a multi-stage bar like you might see in a setup programs with
little effort. For testing, I put them right on the sheet.

Dim a As Integer, b As Integer, c As Integer
Dim x As Long

For a = 1 To 200
ProgressBar1 = a / 2 'scale to 100
For b = 1 To 200
ProgressBar2 = b / 2
For c = 1 To 100
x = x + 1
Next
Next
Next

a = MsgBox(Format(x, "#,#") + " items processed.", vbInformation,
"Processing Complete!")

Roy
 
R

Roy Wagner

Peter,

I have 2 on my controls list as well, but only the latter version will drop
on my sheet. I get a "cannot insert object" message when I try to drop the
version 5.0 SP2, but the version 6.0 works great.

Roy
 
T

Tom Ogilvy

The loops are quite tight in the example I want to use one with and

The ones you talk about. The ones you imply cause the progress bar not to
work.

I said MOD not module. Mod is short for modulus and I should have said
Operator rather than function - my bad. It could be used to reduce the
number of times you need to update the progressbar in your "tight loops".
 
R

RB Smissaert

Just right-click the toolbox and add additional controls.
They are called Microsoft ProgressBar Control.
In my Excel (10) there are a version 5 and 6.
Not sure what the difference is, they both look the same.
Perhaps best to go with version 5 for backward compatibility.

RBS
 
G

Greg Wilson

Rob,

Paste the appended code to a standard (suggest separate) code module. The
progress bar is created if it does not already exist and is destroyed
automatically upon reaching 100% (Terefore, it must be recreated for each run
of the macro). The vast majority of the code is used to create the progress
bar. It could be rewritten to toggle the visible status instead and thus the
code required to operate it would be drastically reduced. I don't like hidden
shapes. That's why I did it this way.

I didn't append the more complex version because I thought it inappropriate.
It is more complex to operate but also allows text messaging and changing the
band colour.

To repeat, when you first call the PB, if you don't specify Size, Left and
Top properties it will use defaults. Afterwards, you need only specify the
value property.

First call example: ProgressBar 5, 170, 100, 100
Subsequent call example: ProgressBar 50

Regards,
Greg

Code follows:-

'Developed by Greg Wilson
'Last Modified: August 2005
'Use of GetDeviceCaps/GetDC/ReleaseDC derived from Stephen Bullen post
'This post apparently no longer available
'Displays simple 3D progress bar constructed of grouped Excel drawing objects

Dim ProgBar As Shape
Dim R1 As Shape, R2 As Shape, R3 As Shape
Dim R4 As Shape, R5 As Shape

Const defSize As Single = 200
Const defLeft As Single = 50
Const defTop As Single = 50
Const defMainBackColor As Single = 12766158
Const defWindowBackColor As Single = vbWhite
Const defIndColor As Single = vbBlue
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90

Private Declare Function GetDC Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "Gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" _
(ByVal dwMilliseconds As Long)

Sub ProgressBar(Val, Optional Size, Optional Left, Optional Top)
If IsMissing(Size) Then Size = defSize
If IsMissing(Left) Then Left = defLeft
If IsMissing(Top) Then Top = defTop
On Error GoTo Destroy
If Not ProgressBarExists Then
MakeProgressBar Val, Size, Left, Top
Else
With ProgBar
.GroupItems(3).Width = Val / 100 * .GroupItems(4).Width
End With
DoEvents
If Val = 100 Then GoTo Destroy
End If
Exit Sub
Destroy:
Sleep 200
ProgBar.Delete
Set ProgBar = Nothing
On Error GoTo 0
End Sub

Private Sub MakeProgressBar(Val, Size, Left, Top)
Dim L As Single, T As Single, W As Single
Dim H As Single, x As Single

With ActiveSheet.Shapes
Set R1 = .AddShape(1, Left, Top, Size, Size / 8)
R1.Fill.ForeColor.RGB = defMainBackColor
Call Make3d(R1, "Raised")
L = Left + 0.04 * Size: T = Top + 0.04 * Size
W = 0.92 * Size: H = 0.05 * Size
Set R2 = .AddShape(1, L, T, W, H)
R2.Line.Visible = False
R2.Fill.ForeColor.RGB = defWindowBackColor
W = 0
Set R3 = .AddShape(1, L, T, W, H)
R3.Line.Visible = False
R3.Fill.ForeColor.RGB = defIndColor
R3.Width = Val / 100 * Size
W = 0.92 * Size
Set R4 = .AddShape(1, L, T, W, H)
R4.Fill.Visible = False
Call Make3d(R4, "Sunken")
Set ProgBar = .Range(Array(R1.Name, R2.Name, R3.Name, R4.Name)).Group
ProgBar.Name = "GW_ProgressBar"
End With
DoEvents
End Sub

Private Sub Make3d(Shp As Shape, EffectType As String)
Dim i As Integer, LineGroup As Shape
Dim L As Single, T As Single, W As Single, H As Single
Dim L1 As Object, L2 As Object, L3 As Object, L4 As Object

L = Shp.Left: T = Shp.Top: W = Shp.Width: H = Shp.Height
Shp.Line.Visible = False
With ActiveSheet
.Unprotect
With .Shapes
Set L1 = .BuildFreeform(msoEditingCorner, 0, 10)
L1.AddNodes msoSegmentCurve, msoEditingCorner, 0, 0
L1.AddNodes msoSegmentCurve, msoEditingCorner, 10, 0
Set L1 = L1.ConvertToShape
Set L2 = L1.Duplicate
L1.Width = W - 2 * PPPX: L1.Height = H - 2 * PPPY
L1.Left = L + PPPX: L1.Top = T + PPPY
L2.Width = W - PPPX: L2.Height = H - PPPY
L2.Left = L: L2.Top = T
Set L3 = .BuildFreeform(msoEditingCorner, 0, 10)
L3.AddNodes msoSegmentCurve, msoEditingCorner, 10, 10
L3.AddNodes msoSegmentCurve, msoEditingCorner, 10, 0
Set L3 = L3.ConvertToShape
Set L4 = L3.Duplicate
L3.Width = W - 2 * PPPX: L3.Height = H - 2 * PPPY
L3.Left = L + PPPX: L3.Top = T + PPPY
L4.Width = W: L4.Height = H
L4.Left = L: L4.Top = T
End With

Select Case EffectType
Case "Raised"
L1.Line.ForeColor.RGB = RGB(240, 240, 240)
L2.Line.ForeColor.RGB = RGB(220, 220, 220)
L3.Line.ForeColor.RGB = RGB(150, 150, 150)
L4.Line.ForeColor.RGB = RGB(50, 50, 50)
Set R1 = .Shapes.Range(Array _
(Shp.Name, L1.Name, L2.Name, L3.Name, L4.Name)).Group
Case "Sunken"
L1.Line.ForeColor.RGB = RGB(50, 50, 50)
L2.Line.ForeColor.RGB = RGB(150, 150, 150)
L3.Line.ForeColor.RGB = RGB(210, 210, 210)
L4.Line.ForeColor.RGB = RGB(240, 240, 240)
Set R4 = .Shapes.Range(Array _
(Shp.Name, L1.Name, L2.Name, L3.Name, L4.Name)).Group
End Select
End With
End Sub

Private Function ProgressBarExists() As Boolean
On Error Resume Next
Set ProgBar = ActiveSheet.Shapes("GW_ProgressBar")
ProgressBarExists = (Err.Number = 0)
On Error GoTo 0
End Function

Private Function PPPX() As Double
'Derived from Stephen Bullen post
Dim hDC As Long
hDC = GetDC(0)
PPPX = 72 / GetDeviceCaps(hDC, LOGPIXELSX)
ReleaseDC 0, hDC
End Function

Private Function PPPY() As Double
'Derived from Stephen Bullen post
Dim hDC As Long
hDC = GetDC(0)
PPPY = 72 / GetDeviceCaps(hDC, LOGPIXELSY)
ReleaseDC 0, hDC
End Function
 

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