A problem to create progress bar in Excel VBA

[Plato2]

I'm trying to creat a progress bar in Excel VBA. So I created a form with a lable and I'm coloring the lable according to the progress... But when I display this popup progress bar my excel code stops working after I displayed the progress bar.

How can I solve the problem?
I need my excel to continue working after I displayed a progress bar.
I use: UserForm2.Show to show the progress bar.
and after this line my code stops working

Thanks in advance

 

[Plato2]

I tried to used UserForm2.Show vbModeless and it started to work but I don't see the text messages on the progress bar - all the messages disappeared

Any ideas?

Thanks in advance

 

[macropod]

Hi,

Check out:

http://j-walk.com/ss/excel/tips/tip34.htm

There is a ready-made solution there, though it doesn't include colour changes. Another, simpler approach, would be to update the status bar, but colour-changes might be out of the question.

Cheers

 

[marcus101]

Plato:

Dude, you're gonna have to show us the code you are using, because there could be a whole bunch of things that might be going wrong here and that might be causing the problem in terms of the code getting interrupted or ending prematurely.

Here's what I use for this sort of thing:

1. A sub to show/start the progress bar/form
2. A sub to update the progress of the bar/form
3. A call inside your main VB Sub to update the progress (usually placed inside a loop)
4. A userForm that has all of the elements (the frame, the textlabel for the bar, which can be color changed, BTW), etc.

1. Sub ShowProg()

UserForm1.LabelProg.Width=0
UserForm1.Show

End Sub

2. Sub UpdateProg(Pct)

With UserForm1

.FrameProg.Caption = Format(Pct, "0%")
.LabelProg.Width = Pct * (.FrameProg.Width - 10)
.Repaint ' this part is critical

End With

End Sub

3. Sub Main() ' your main VB code/app..

Count=1

For r = 1 to endRows

For c = 1 to endCols

' code for your app..

Count = Count + 1

Next c

PctComp = Count / (endRows/endCols)
Call UpdateProg(PctComp)

Next r

Unload UserForm1

End Sub

4. UserForm

Build a simple user form. Add a frame and set its default caption to "0%". Name this frame "FrameProg" in the Properties.

Add a textlabel inside the frame, remove the caption and then change the background color to red or green or blue. Name this label "LabelProg" in the Properties.

Then resize this smaller block so that it resembles a thin rectangle that is no more than a 1cm or so wide.

It really doesn't matter what size it is because the form will resize it to zero but it should be positioned at the far left side of the form/frame so it gets resized and fills the frame area correctly.

Hope this helps.

marcus101
xdsmarcus@gmail.com

marcus101
Access/SQL/XML Developer
Ottawa, Canada

 

[MCubitt]

Marcus,

This and similar code appears to be very popular on my Google searches, but I just cannot get it to work!

Currently, the userform is displayed but the bar is not. The userform does not disappear either, I have to X (to close) it off and then processing continues. It has not even got to my looping!

My code.. excuse some testing bits n bobs

Sub ExportCSV_Click()
    ' Show egg timer
    Application.Cursor = xlWait
    
    maxcount = 20
    counter = 0
    
    Call ShowProg
     
    Call writecsv(1, 1, 20, 1, 100, counter, maxcount)
   
    Unload UserForm1
    
    ' Show mouse pointer
    Application.Cursor = xlDefault
End Sub

Sub writecsv(sheet, startrow, endrow, startcol, endcol, counter, maxcount)
    Filename = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1) + "_" + Sheets(sheet).Name + ".csv"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set file = FSO.createtextfile(Filename, True, False)
    For Row = startrow To endrow
      
      counter = counter + 1
      PctComp = counter / maxcount
      Call UpdateProg(PctComp)
      m = MsgBox(counter)
      
      If ActiveWorkbook.Sheets(sheet).Cells(Row, 3).Value <> "" Then
        textstring = Empty
        For col = startcol To endcol
          If col > 1 Then textstring = textstring & ","
          textstring = textstring & ActiveWorkbook.Sheets(sheet).Cells(Row, col).Value
        Next
        file.writeline (textstring)
      End If
    Next
    file.Close
End Sub

Sub ShowProg()

    UserForm1.LabelProg.Width = 0
    UserForm1.Show

    End Sub

Sub UpdateProg(Pct)

    With UserForm1
  
    .FrameProg.Caption = Format(Pct, "0%")
    .LabelProg.Width = Pct * (.FrameProg.Width - 10)
    .Repaint ' this part is critical

    End With

    End Sub

Any ideas?

The m = MsgBox(counter) only shows after I close the frame and by then, it wont update because I closed it!

There's no need for sarcastic replies, we've not all been this sad for that long!

 

[DeeBeeGee]

Macropod,
Is your site still available? I cannot get a connection to see your ready built progress bar.

 

[xlbo]

DeeBeeGee - it is not on Macropod's site - it is on
J-Walk.com

I can follow the link just fine

Rgds, Geoff

"Three things are certain: Death, taxes and lost data. Guess which has occurred"

Please read FAQ222-2244 before you ask a question