Barra de progreso

[beneco]

Buenas tardes en este foro encontrè este còdigo el cual quiero adaptar a mis necesidades en un botòn de comando, pero sin la parte del còdigo para rellenar la hoja de càlculo, ùnicamente para que funcione la barra de progreso.

de ante mano mil gracias por su colaboraciòn:





Private Sub UserForm_Activate()
' Set the width of the progress bar to 0.
UserForm1.LabelProgress.Width = 0

' Call the main subroutine.
Call Main
End Sub

___________________________________________

Sub ShowUserForm()
UserForm1.Show
End Sub

Sub Main()
Dim Counter As Integer
Dim RowMax As Integer, ColMax As Integer
Dim r As Integer, c As Integer
Dim PctDone As Single

Application.ScreenUpdating = False
' Initialize variables.
Counter = 1
RowMax = 100
ColMax = 25

' Loop through cells.
For r = 1 To RowMax
For c = 1 To ColMax
'Put a random number in a cell
Cells(r, c) = Int(Rnd * 1000)
Counter = Counter + 1
Next c

' Update the percentage completed.
PctDone = Counter / (RowMax * ColMax)

' Call subroutine that updates the progress bar.
UpdateProgressBar PctDone
Next r
' The task is finished, so unload the UserForm.
Unload UserForm1
End Sub

Sub UpdateProgressBar(PctDone As Single)
With UserForm1

' Update the Caption property of the Frame control.
.FrameProgress.Caption = Format(PctDone, "0%")

' Widen the Label control.
.LabelProgress.Width = PctDone * _
(.FrameProgress.Width - 10)
End With

' The DoEvents allows the UserForm to update.
DoEvents
End Sub