PDA

View Full Version : Progress Bar - Need some help


cortiz1bog
10-18-2005, 05:24 AM
I have the following code for the Userform:

Private Sub UserForm_Activate()
Dim N&
'*******PROPERTIES*******
With UserForm1
'(set form properties)
.Height = 120
.Width = 380
.Caption = "My Progress Indicators"
End With
With ProgressBar1
'(set prog.bar1 properties)
.Height = 15
.Width = 355
.Left = 10
.Top = 30
.Min = 0
.Max = 40
.Scrolling = ccScrollingStandard
End With

With Label1
'(set label1 properties)
.Height = 15
.Width = 130
.Left = 10
.Top = 15
End With

'*******PROGRESS********
For N = 1 To 40
ProgressBar1 = N
Label1 = "Individual Progress = " & N * 2.5 \ 1 & "%"
DoEvents
Next N


Unload Me
End Sub

For the module:

Private Sub AddReference()
On Error Resume Next '< error = reference already set
'set reference to Microsoft Windows Common Controls 6.0 (SP4)
'(aka: Microsoft Progress Bar Control 6.0 (SP4))
ThisWorkbook.VBProject.References.AddFromGuid _
"{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}", 2, 0
End Sub

Sub ShowForm()
Call AddReference
UserForm1.Show
End Sub

Now, I know that I have to:

"To give the progress of the procedure you're running, you will need to put a reference to the value of the progress indicator at the points in your code where you want the progress to be updated. "

This is where I need help, can somebody point in the right direction and show what and where do I need to put "Some code" in the following procedure to make the two codes work together.

Sub InfoFinal102()
Application.ScreenUpdating = False
ShowForm
'HERE GOES 0 % PROGRESS ? WHAT AND HOW?'
'N = 0'

Sheets("FACTURA").Select
Range("T184:AB184").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("F65536").Select
Selection.End(xlUp).Select
'HERE GOES 25% PROGRESS '
'N = 25 % ?'

Sheets("EGRESOS").Select
Range("AP183:BR183").Select
Application.CutCopyMode = False
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("N65536").Select
Selection.End(xlUp).Select
'HERE GOES 50 % PROGRESS '
'N = 50 % ?'

Sheets("TURNOS").Select
Range("V211:AE211").Select
Application.CutCopyMode = False
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("G65536").Select
Selection.End(xlUp).Select
'HERE GOES 75 % PROGRESS '
'N = 75 % ?'

Sheets("IMPTOS").Select
Range("L3:Y3").Select
Application.CutCopyMode = False
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B65536").Select
Selection.End(xlUp).Select
'HERE GOES 100 % PROGRESS '
'N = 100 % ?'

MsgBox "AHORA EL PROGRAMA FUNCIONARA RAPIDO - SU LIBRO DE TRABAJO NO ES TAN PESADO - BUENA LABOR HA HECHO HOY - HASTA PRONTO", vbInformation
Application.ScreenUpdating = True
ActiveWorkbook.Sheets("BOTONES").Activate

End Sub

Thank you

Cesar
Bob Phillips
10-18-2005, 05:55 AM
Hardly worth a progress bar, it should flash by



Private Sub UserForm_Activate()
Dim n&
'*******PROPERTIES*******
With UserForm1
'(set form properties)
.Height = 120
.Width = 380
.Caption = "My Progress Indicators"
End With
With ProgressBar1
'(set prog.bar1 properties)
.Height = 15
.Width = 355
.Left = 10
.Top = 30
.Min = 0
.Max = 40
.Scrolling = ccScrollingStandard
End With

With Label1
'(set label1 properties)
.Height = 15
.Width = 130
.Left = 10
.Top = 15
End With

InfoFinal102
Unload Me
End Sub



Option Explicit

Sub InfoFinal102()
Dim oPB As Control
Dim n As Long

Set oPB = UserForm1.ProgressBar1

Application.ScreenUpdating = False
n = 0
oPB.Value = oPB.Max * n / 100
oPB.Label1.Caption = "Individual Progress = " & n & "%"

Sheets("FACTURA").Select
Range("T184:AB184").Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("F65536").End(xlUp).Select
n = 20
oPB.Value = oPB.Max * n / 100
oPB.Label1.Caption = "Individual Progress = " & n & "%"

Sheets("EGRESOS").Select
Range("AP183:BR183").Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("N65536").End(xlUp).Select
n = 40
oPB.Value = oPB.Max * n / 100
oPB.Label1.Caption = "Individual Progress = " & n & "%"

Sheets("TURNOS").Select
Range("V211:AE211").Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("G65536").End(xlUp).Select
n = 60
oPB.Value = oPB.Max * n / 100
oPB.Label1.Caption = "Individual Progress = " & n & "%"

Sheets("IMPTOS").Select
Range("L3:Y3").Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B65536").End(xlUp).Select
n = 80
oPB.Value = oPB.Max * n / 100
oPB.Label1.Caption = "Individual Progress = " & n & "%"

MsgBox "AHORA EL PROGRAMA FUNCIONARA RAPIDO - SU LIBRO DE TRABAJO NO ES TAN PESADO - BUENA LABOR HA HECHO HOY - HASTA PRONTO", vbInformation
Application.ScreenUpdating = True
ActiveWorkbook.Sheets("BOTONES").Activate

End Sub
cortiz1bog
10-18-2005, 06:31 AM
It looks so simple, thanks...
I will give a try, I have the file on a different machine and location and let you know how it works.

By the way what oPB, controls means, this is all new to me.

Once again 1000 thanks

Cesar
Bob Phillips
10-18-2005, 06:46 AM
It looks so simple, thanks...
I will give a try, I have the file on a different machine and location and let you know how it works.

By the way what oPB, controls means, this is all new to me.

That is just me setting a variable to make it easier to work with.
johnske
10-18-2005, 02:12 PM
Hi cesar,

Without trying it out, just a little tweak... in the code that xld's given you, I think you'll find you probably need a DoEvents on the line immediately after each instance of oPB.Label1.Caption = "Individual Progress = " & n & "%"

HTH,
John :)
Bob Phillips
10-18-2005, 02:27 PM
Hi cesar,

Without trying it out, just a little tweak... in the code that xld's given you, I think you'll find you probably need a DoEvents on the line immediately after each instance of oPB.Label1.Caption = "Individual Progress = " & n & "%"

The way I have implemented I don't think that is necessary, I am not needing to allow other events to happen.

I did have a coding error though, corrected here.

Option Explicit

Sub InfoFinal102()
Dim oPB As Control
Dim n As Long

Set oPB = UserForm1.ProgressBar1

Application.ScreenUpdating = False
n = 0
oPB.Value = oPB.Max * n / 100
UserForm1.Label1.Caption = "Individual Progress = " & n & "%"

Sheets("FACTURA").Select
Range("T184:AB184").Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("F65536").End(xlUp).Select
n = 20
oPB.Value = oPB.Max * n / 100
UserForm1.Label1.Caption = "Individual Progress = " & n & "%"

Sheets("EGRESOS").Select
Range("AP183:BR183").Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("N65536").End(xlUp).Select
n = 40
oPB.Value = oPB.Max * n / 100
UserForm1.Label1.Caption = "Individual Progress = " & n & "%"

Sheets("TURNOS").Select
Range("V211:AE211").Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("G65536").End(xlUp).Select
n = 60
oPB.Value = oPB.Max * n / 100

Sheets("IMPTOS").Select
Range("L3:Y3").Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B65536").End(xlUp).Select
n = 80
oPB.Value = oPB.Max * n / 100
UserForm1.Label1.Caption = "Individual Progress = " & n & "%"

MsgBox "AHORA EL PROGRAMA FUNCIONARA RAPIDO - SU LIBRO DE TRABAJO NO ES TAN PESADO - BUENA LABOR HA HECHO HOY - HASTA PRONTO", vbInformation
Application.ScreenUpdating = True
ActiveWorkbook.Sheets("BOTONES").Activate

End Sub
cortiz1bog
10-21-2005, 12:41 PM
I have a problem

I am running Office 2000 and course the objects use above do not apply to Office 2000, I think...? since I keep getting error 438 so, the only progrees bar available that I found in the tool box is: Microsoft Progress bar version 5.0 (SP2) which I am using for the process attach here.

Something does not work, I can not see the progress bar running, but the macro InfoFinal102 runs ok.

What am I doing wrong
Module:
Option Explicit

Private Sub AddReference()
On Error Resume Next
End Sub

Sub ShowForm()
Call AddReference
UserForm1.Show
End Sub

Userform1:
Option Explicit
Private Sub UserForm_Activate()
Dim N
'*******PROPERTIES*******
With UserForm1
'(set form properties)
.Height = 120
.Width = 380
.Caption = "My Progress Indicator"
End With

With ProgressBar1
'(set prog.bar1 properties)
.Height = 15
.Width = 355
.Left = 10
.Top = 30
.Min = 0
.Max = 40

End With

With Label1
'(set label1 properties)
.Height = 15
.Width = 130
.Left = 10
.Top = 15
End With

InfoFinal102
Unload Me
End Sub

The macro where the Progress Bar should show while is running:

Sub InfoFinal102()
Dim oPB As Control
Dim N As Long

Set oPB = UserForm1.ProgressBar1

Application.ScreenUpdating = False
N = 0
oPB.Value = oPB.Max * N / 100


Sheets("FACTURA").Select
Range("T184:AB184").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("F65536").Select
Selection.End(xlUp).Select
N = 20
oPB.Value = oPB.Max * N / 100



Sheets("EGRESOS").Select
Range("AP183:BR183").Select
Application.CutCopyMode = False
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("N65536").Select
Selection.End(xlUp).Select
N = 40
oPB.Value = oPB.Max * N / 100



Sheets("TURNOS").Select
Range("V211:AE211").Select
Application.CutCopyMode = False
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("G65536").Select
Selection.End(xlUp).Select
N = 60
oPB.Value = oPB.Max * N / 100


Sheets("IMPTOS").Select
Range("L3:Y3").Select
Application.CutCopyMode = False
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B65536").Select
Selection.End(xlUp).Select
N = 80
oPB.Value = oPB.Max * N / 100


MsgBox "AHORA EL PROGRAMA FUNCIONARA RAPIDO - SU LIBRO DE TRABAJO NO ES TAN PESADO - BUENA LABOR HA HECHO HOY - HASTA PRONTO", vbInformation
Application.ScreenUpdating = True
ActiveWorkbook.Sheets("BOTONES").Activate

End Sub


I took out the line:

oPB.Label1.Caption = "Individual Progress = " & n & "%"

Since I keep getting an error 438

Now, when I run the InfoFinal102 macro, the progress bar does not show while the macro run ok .

Please help

Cesar Ortiz