Results 1 to 5 of 5
  1. #1
    Join Date
    Aug 2003
    Location
    Northampton, UK
    Posts
    6

    Post Unanswered: Status bar/ downlaod bar

    I got a form that you press a bution and it goes off a does some stuff, it take about 4 mins to get the data and sort it ,

    i would like to open a new form that informts the user that stuff is getting done, I looked into using a .gif, but i'm not convinece that VBA can handle them (esp with out adding some .DLL which i can't be asked to do)

    I was thinking that there may be some control or some thing that i could use to show the programe is working, any one got any ideas?

    you now the sort of thing i mean, somthing lik when you doen load or copy file, a visual.

    thanks
    Wellephant

  2. #2
    Join Date
    Aug 2003
    Posts
    15

    Re: Status bar/ downlaod bar

    You can use a control called Microsoft Status Bar. You can either add it to the bottom of the form you have the button on or build a new form to put it on that will be triggered to open when the button is pushed(build macro to do this). Then just set the properties on the status bar. Let me know if this is clear.

  3. #3
    Join Date
    Aug 2003
    Location
    Northampton, UK
    Posts
    6

    Re: Status bar/ downlaod bar

    Thanks,

    Yeah I found it when i looked a bit harder.

    I have a few issues with my form (i put it on a new form) sometimes it goes white and does not display proper. Also have a list box which should put in the name of some thing each time a loop finished (which also adds to the probar), the progbar updates but the list box does not, same with some label captions of the form, they don't update, until the end, any ideas?

    thanks

    Wellephant Dictor

  4. #4
    Join Date
    Aug 2003
    Posts
    15

    Re: Status bar/ downlaod bar

    there is something amiss with your code in the loop. Please list your code.

  5. #5
    Join Date
    Aug 2003
    Location
    Northampton, UK
    Posts
    6

    Question Re: Status bar/ downlaod bar

    My code is a bit messy, I have take out the none relevant bits hope it makes sense

    Private Sub CommandButton9_Click()


    UserForm4.Label1.Caption = "Initializing..."
    UserForm4.Show vbModeless


    If MsgBox("This data has been used to run Dispatch History before, the data may not be upto date. Do " _
    & "you wish to use this data again? If so click Yes to continue. If you would like to load a new file " _
    & "click No to exit and load the new file.", 4 + vbInformation, "File History - Preused data set") = vbNo Then
    Unload UserForm4
    Exit Sub
    End If

    ‘IF THIS IS NOT DISPALYED THEN THE FORM (USERFORM4) DISPALYS AS WHITE< UNTIL THE PROGBAR ‘DISPLAYS WHEN IT IS WHITE WITH A PROGBAR ON IT. IT ONLY GOES GARY WHEN THE CODES STOPS


    ‘********************************
    ‘DOES SOME OTHER STUFF
    ‘********************************

    UserForm4.ProgressBar1.Min = 0
    UserForm4.ProgressBar1.Max = pbrcust - 10
    UserForm4.Label1.Caption = "Progressing..."

    ‘THE CAPTION DOES NOT CHANGE TO PROGRESSING IT STAYS AS INITIALIZING
    ‘pbrcust IS A COUNT OF CELLSS LESS 10, @CAUSE THAT’S WHERE THE COUNT STARTS



    ‘********************************
    ‘DOES SOME OTHER STUFF
    ‘********************************


    'THIS IS THE MAIN LOOP THAT UPDATES THE PROGBAR SO I’VE LEFT IT AS IT IS.
    __________________________________________________ ___
    'this code puts ecah del amount in a colum for each customer on each date
    Dim AC As Variant 'acount number
    Dim IBCval As Variant ' used to count the number of IBC's
    Dim dateval As Date ' used to store the date
    Dim Name As String ' for use with prog bar form

    Customercol = 10 ' used to move to the next cusomer acount colum
    acrow = 7 ' used to move down the list of dels for each acount number
    daterow = 6 ' used to look trhough the date that have been added under tyhe customer acounts (i.e. where to put the count of IBCs
    writeyn = 0 ' used as a flag to see if data was added


    Do Until Worksheets("1").Cells(5, Customercol) = "" 'goes down all the customer name (left to right)


    AC = Worksheets("1").Cells(5, Customercol).Value 'start at the first acount number then adds next one
    Name = Worksheets("1").Cells(4, Customercol).Value

    Do Until Worksheets("1").Cells(acrow, 3).Value = ""


    If Worksheets("1").Cells(acrow, 1).Value = AC Then

    If Worksheets("1").Cells(acrow, 4).Value = "IB2" Or _
    Worksheets("1").Cells(acrow, 4).Value = "IBC" Then



    IBCval = Worksheets("1").Cells(acrow, 5)
    dateval = Worksheets("1").Cells(acrow, 6)

    ' If Worksheets("1").Cells(daterow, 9) >= _
    ' dateval Then
    ' daterow = daterow
    ' Else
    ' daterow = 6
    ' End If

    ' at this point the prog has to put this data in to the right slot on the other half og the page

    Do Until Worksheets("1").Cells(daterow, 9).Value = "" 'this goes through uintil the right date is mtahced then adds the value to what evewas in that else, it then trues on a marcker, if the marker is not switched, a mesgbox is dispalyed to tell the user
    If Worksheets("1").Cells(daterow, 9).Value = dateval Then

    Worksheets("1").Cells(daterow, Customercol).Value = _
    Worksheets("1").Cells(daterow, Customercol).Value + IBCval

    writeyn = 1
    daterow = 6
    Exit Do

    Else
    daterow = daterow + 1


    End If
    Loop

    If writeyn = 0 Then


    MsgBox "Sorry this date " & dateval & " could not be found and the IBC will not be added" & Chr(13) & Chr(13) _
    & "If this problem persists contact Ross McLean", vbOKOnly


    Exit Do
    Else
    writeyn = 0
    End If

    acrow = acrow + 1

    Else
    acrow = acrow + 1
    End If
    Else
    acrow = acrow + 1
    End If

    Loop


    Customercol = Customercol + 1
    acrow = 7
    daterow = 6

    '_________________________________________________ ____
    'PROGRESS BAR CODE ONLY

    pbrDone = pbrDone + 1
    UserForm4.ProgressBar1.Value = pbrDone
    UserForm4.Label6.Caption = Name
    'DoEvents
    'Dim cItems As Integer



    UserForm4.ListBox1.AddItem "Checked: " & Name
    ' if more than xx items shown, then need to scroll down...
    cItems = UserForm4.ListBox1.ListCount
    ' don't know how to get scrolling directly,
    ' so just "select" the last item, which will
    ' cause it to scroll into view...
    UserForm4.ListBox1.ListIndex = cItems - 1
    'userform4.ListBox1.



    Loop
    'loop now fished


    UserForm4.CommandButton1.Enabled = True
    UserForm4.Label5.Visible = False
    UserForm4.Label6.Visible = False
    UserForm4.ListBox1.Visible = True


    UserForm4.Label1.Caption = "Finshed"
    'UserForm4.ProgressBar1.Value = 0

    UserForm4.Label3.Caption = "Time Taken:"
    UserForm4.Label3.Visible = True
    UserForm4.Label4.Caption = x & " Seconds"
    UserForm4.Label4.Visible = True

    ‘******************************
    ‘THE ABOVE WORKS FINE.
    ‘****************************
    'Start = Timer
    'PauseTime = 5
    '
    ' Do Until Timer > Start + PauseTime
    ' DoEvents
    ' Loop

    End Sub

Posting Permissions

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