Ok, below is the code. Be forewarned, you need to do some work yourself now.
BTW, did you look at those resources I referenced???
Create a UserForm. Pup this code into the UserForm:
Private Sub UserForm_Initialize()
UserCancelled = False
End Sub
The UserForm is named 'frmProgress'
Add a TextBox to the UserForm. Name the TextBox 'imgProgFore'
Add a ClassMOdule and enter this code:
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
Create a Module, and pop in this code:
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
'Application.ScreenUpdating = False
Dim sh As Worksheet
Dim sht As Worksheet
PB.Progress = 5
....now intersperse your code and more of this...
PB.Progress = 10
PB.Progress = 15
....
are you getting it...??????
....
PB.Progress = 95
PB.Progress = 100
PB.Finish
End Sub
Good luck,
Ryan---