Consulting

Results 1 to 7 of 7

Thread: Progress Bar - Need some help

  1. #1

    Progress Bar - Need some help

    I have the following code for the Userform:

    [VBA]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[/VBA]

    For the module:

    [VBA]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[/VBA]

    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.

    [VBA]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[/VBA]

    Thank you

    Cesar

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Hardly worth a progress bar, it should flash by

    [VBA]

    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[/VBA]


    [VBA]
    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[/VBA]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    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

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Quote Originally Posted by cortiz1bog
    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.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  5. #5
    Administrator
    Chat VP
    VBAX Guru johnske's Avatar
    Joined
    Jul 2004
    Location
    Townsville, Australia
    Posts
    2,872
    Location
    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 [vba]oPB.Label1.Caption = "Individual Progress = " & n & "%"[/vba]

    HTH,
    John
    You know you're really in trouble when the light at the end of the tunnel turns out to be the headlight of a train hurtling towards you

    The major part of getting the right answer lies in asking the right question...


    Made your code more readable, use VBA tags (this automatically inserts [vba] at the start of your code, and [/vba ] at the end of your code) | Help those helping you by marking your thread solved when it is.

  6. #6
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Quote Originally Posted by johnske
    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 [vba]oPB.Label1.Caption = "Individual Progress = " & n & "%"[/vba]
    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.

    [VBA]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
    [/VBA]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  7. #7
    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:
    [VBA]Option Explicit

    Private Sub AddReference()
    On Error Resume Next
    End Sub

    Sub ShowForm()
    Call AddReference
    UserForm1.Show
    End Sub[/VBA]

    Userform1:
    [VBA]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[/VBA]

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

    [VBA]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[/VBA]


    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •