VBA Question on creating a progress bar ...

Question

I have a macro that I built for Power Point that saves each slide as a jpeg file in sequence. As shown below:

Sub SlideIndex()

Dim osld As Slide

On Error Resume Next

MkDir Environ("USERPROFILE") & "\Desktop\jpgs"

For Each osld In ActivePresentation.Slides

osld.Export Environ("USERPROFILE") & "\\Desktop\jpgs\Slide" & Format(osld.SlideIndex, "000" & ".jpg"), "JPG"

Next osld

End Sub

The formatting was required in order to get the images to display in the proper sequence on another device, (we display the images on a large flat screen TV).  I would like to add a progress bar, if possible to this routine to show how far the routing has gone towards saving the entire file.  Perhaps show a change on every 5% saved.  I don't know if there is a progress bar widget that can be used or not with Power Point 2007, but it would be useful to do something here.

Your help is greatly appreciated.

Answer 1

To illustrate how, start with a blank presentation.  In the Visual Basic editor, insert a new UserForm.  On that UserForm (default name = UserForm1), add the following control:

Microsoft ProgressBar Control, version 6.0

You will find it in the "Addition Controls" list from the "Tools" menu in the VBE.

Now add a general code module and copy the code below into it.  Run the code to see how you use the control.  It is important to run the form as "vbModeless" so that your background processing (saving the JPG files) will continue and the form will update.

Adapt the code to your needs.

HTH,

Eric

Option Explicit

Sub TestProgressBar()

    Dim i As Long

'

    UserForm1.ProgressBar1.Value = 0

    UserForm1.ProgressBar1.Min = 0

    UserForm1.ProgressBar1.Max = 100

'

    UserForm1.Show vbModeless

'

    For i = 1 To 1000000000

        If i Mod 10000000 = 0 Then

            UserForm1.ProgressBar1.Value = i / 10000000

            UserForm1.ProgressBar1.Refresh

            UserForm1.Repaint

            DoEvents

        End If

    Next i

 '

    UserForm1.Hide

End Sub