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