Unbound status bar

[hooks]

I am almost finished with an unbound form status bar that will be able to be called from any other form with properties for status bar color, at what percentage to update status bar and minimum number of records to display status bar.

I have tested it with a 950,000 count record set and it doesn't slow it down at all. It will load it in about 10 seconds.

Would any of you be interested in looking at the code to make it more efficient? I am very new to vba.

It might be another day or so before i post it so that i can to clean up the code to make it readable.

Thanks Hooks

 

[hooks]

OK, Here is my little progress bar. Please help me make this more efficient. As it is right now i am opening up a recordset that has about 950,000 records in about 12 seconds using my progress bar. It takes about 7 seconds to open the query without the progress bar. I know this isn't that big of a deal because i will probably never have to open more than 100,000 records. I am just trying to learn how to make vba code faster and better.

Here is the code on my generic form that opens the SQL statement.
The recordset is already open and here is where you set the Progress bar parameter.

[COLOR=Green]'***** Progress Bar *****[/COLOR]
    
[COLOR=Green]    'If recordcount is larger than 1000 then show the progress bar[/COLOR]
    If RecSet.RecordCount > 1000 Then
[COLOR=Green]        'Open Progress Bar Form
        
                'Parameters
        'Show ProgBarText  True, False
        'Percentage increment to update the Progress bar
            'Example -- a value of 10 would show
            '10% completed, 20% completed, 30% completed on
            'The Progress bar
[COLOR=DarkGreen]        'RecordCount
        'ProgBarBackColor
        'ProgBarColor
        'ProgBarTextColor
        'ProgBarFromColor[/COLOR]

        ' -1 = default colors - You can change the default colors in the module[/COLOR]
        Call ProgressBarOpen(True, 1, RecSet.RecordCount, -1, -1, -1, -1)
        While Not RecSet.EOF
            Call ProgressBarUpdate
            RecSet.MoveNext
        Wend
        
        Call ProgressBarClose    [COLOR=Green] 'Close the form[/COLOR]
    End If

Here is the first Function in the Progress Bar Module that sets the parameters

Option Compare Database
Option Explicit

Dim dblCurRec As Double            [COLOR=Green] 'Current record number[/COLOR]

Dim dblPercent As Double           [COLOR=Green] 'Unformatted percent of total records processed[/color]

Dim dblPercentProcessed As Double  [COLOR=Green] 'Formatted percent of total records processed[/COLOR]

Dim frmProgressBar As Form

Dim PercentCounter As Integer       [COLOR=Green]'Number of records within a giving percent
[/COLOR]
Public DisplayIncrement As Integer [COLOR=Green] 'Percentage increment to update the [/COLOR]Progress bar
                                   [COLOR=Green] 'Example -- a value of 10 would show
                                    '10% completed, 20% completed, 30% completed on
                                    'The Progress bar[/COLOR]
                                    
Public RecCount As Double
                                    
Dim oldpercent As Integer          [COLOR=Green] 'The previous percent processed
                                    'Used only if DisplayIncrement is 1
                                

'Open and Setup the Parameters for the Progress bar form[/COLOR]
Public Function ProgressBarOpen(ShowProgBarText As Boolean, _
    DisplayIncrement1 As Integer, RecCount1 As Double, _
    BarBackColor As Integer, ProgBarColor As Integer, _
    ProgBarTextColor As Integer, ProgressBarFormColor As Integer)
    
On Error GoTo err_ProgressBarOpen

    DisplayIncrement = DisplayIncrement1
    RecCount = RecCount1

    DoCmd.OpenForm "frmProgressBar"
    oldpercent = 0
        
    If ProgressBarFormColor = -1 Then
        [Forms]![frmProgressBar].Detail.BackColor = 12632256
    Else
        [Forms]![frmProgressBar].Detail.BackColor = ProgressBarFormColor
    End If
    
   [COLOR=Green] 'Show or hide the percentProgresstext[/COLOR]
    If ShowProgBarText = False Then
        [Forms]![frmProgressBar]![ProgBarText].Visible = False
    Else
        [Forms]![frmProgressBar]![ProgBarText].Visible = True
    End If
        
    If BarBackColor = -1 Then
        [Forms]![frmProgressBar]![ProgBar].BackColor = "16473867"
    Else
        [Forms]![frmProgressBar]![ProgBar].BackColor = BarBackColor
    End If
        
    If ProgBarColor = -1 Then
        [Forms]![frmProgressBar]![ProgBarText].ForeColor = "0"
    Else
        [Forms]![frmProgressBar]![ProgBarText].ForeColor = ProgBarColor
    End If
        
    If ProgBarTextColor = -1 Then
        [Forms]![frmProgressBar]![ProgBarBack].BackColor = "12632256"
    Else
        [Forms]![frmProgressBar]![ProgBarBack].BackColor = ProgBarTextColor
    End If
    
    DoCmd.RepaintObject acForm, "frmProgressBar"
    
Exit_ProgressBarOpen:
    Exit Function

err_ProgressBarOpen:
    MsgBox Err.Number & vbCrLf & _
    Err.Description & vbCrLf & _
    Err.Source, vbCritical, "ERROR"
    
    Resume Exit_ProgressBarOpen:
    
End Function

Here is where the problem lies I think.

Public Function ProgressBarUpdate()
On Error GoTo err_ProgressBarUpdate

    dblCurRec = dblCurRec + 1
    dblPercent = (dblCurRec / RecCount)
    dblPercentProcessed = Format$(dblPercent * 100, "##")
    
    If DisplayIncrement = 1 Then
        If oldpercent = dblPercentProcessed Then
            Exit Function
          [COLOR=Green]  'The current record is within a percentage that has already been _
            'displayed on the Progress form
            'This skips the Progress bar repaint routine
            'if we didn't do this the Progress bar form would update with every
            'record in the recordset slowing things way down[/COLOR]
            
        Else
           [COLOR=Green] 'the current record is the first record in a new percentage range
            'so we repaint the Progress bar to get the new percentage
            
            'Update percentage text[/COLOR]
            Forms!frmProgressBar!ProgBarText.Caption = dblPercentProcessed & "% complete"
            
           [COLOR=Green] 'Update ProgressBar graphic box[/COLOR]
            Forms!frmProgressBar!ProgBar.Width = _
                (Forms!frmProgressBar!ProgBarBack.Width / RecCount) * dblCurRec
            DoCmd.RepaintObject acForm, "frmProgressBar"
            
            oldpercent = oldpercent + 1
            Exit Function
        End If
    Else
           [COLOR=Green] 'If the percent processed is divisible by the DisplayIncrement variable[/COLOR]
        If dblPercentProcessed Mod DisplayIncrement = 0 Then
           [COLOR=Green] 'Add 1 to the percentcounter to see how many records are in current percent[/COLOR]
            PercentCounter = PercentCounter + 1

            If PercentCounter = 1 Then
               [COLOR=Green] 'PercentCounter = 1 so we are on the first record of this percentage
                'Update the graphics[/COLOR]
                [Forms]![frmProgressBar]![ProgBarText].Caption = _
                    dblPercentProcessed & "% complete"
                [Forms]![frmProgressBar]![ProgBar].Width = _
                    ([Forms]![frmProgressBar]![ProgBarBack].Width / RecCount) * dblCurRec
                DoCmd.RepaintObject acForm, "frmProgressBar"
            End If
        Else
            PercentCounter = 0
        End If
    End If

Exit_ProgressBarUpdate:
    Exit Function
    
err_ProgressBarUpdate:
    If Err.Number = 13 Then     'Division by Zero
        Exit Function
    End If
    MsgBox Err.Number & vbCrLf & _
    Err.Description & vbCrLf & _
    Err.Source, vbCritical, "ERROR"
    
    Resume Exit_ProgressBarUpdate:
End Function

Clean Up

Public Function ProgressBarClose()
On Error GoTo err_ProgressBarClose
    
    [Forms]![frmProgressBar].Caption = "                         Complete"
    Forms!frmProgressBar!ProgBarText.Caption = "100% complete"
    [Forms]![frmProgressBar]![ProgBar].Width = _
        [Forms]![frmProgressBar]![ProgBarBack].Width
    
    DoCmd.Beep
    PauseProgramInSeconds (1)
   [COLOR=Green] 'Clean Up[/COLOR]
    dblCurRec = vbNull
    dblPercent = vbNull
    dblPercentProcessed = vbNull
    PercentCounter = vbNull
    DisplayIncrement = vbNull
    oldpercent = vbNull
    DoCmd.Close acForm, "frmProgressBar"
    
Exit_ProgressBarClose:
    Exit Function
    
err_ProgressBarClose:
    MsgBox Err.Number & vbCrLf & _
    Err.Description & vbCrLf & _
    Err.Source, vbCritical, "ERROR"
    Resume Exit_ProgressBarClose:
End Function

Pause program code

Public Function PauseProgramInSeconds(duration As Integer)
    Dim PauseTime, Start, Finish, TotalTime
    PauseTime = duration   [COLOR=Green] ' Set duration.[/COLOR]
    Start = Timer    [COLOR=Green]' Set start time.[/COLOR]
    Do While Timer < Start + PauseTime
        DoEvents   [COLOR=Green] ' Yield to other processes.[/COLOR]
    Loop
End Function

 

[WayneRyan]

Hooks,

I didn't paste the code into an app, but I have some observations.

1) I think that 1% granularity is too fine, 5% would convey the
status adequately.

2) I would have the main code do the following:

Granularity = rst.RecordCount/20

Then when you process each record:

If rst.AbsolutePosition Mod Granularity = 0 Then
...ProgressBarUpdate(...)
End If

This would save you formatting each record number.

Overall, "looks" pretty good though!

btw,
Why use the PauseProgramInSeconds function?

Wayne

 

[hooks]

Wayne

I have a parameter where you can set the Granularity. I just had it set to 1 for testing purposes. If i change it to say 10 or 20 the program takes just as long as it does if it is set at 1.

My progress bar form is only repainting if the percent processed has changed.

For example if you have 100,000 records in the record set and the module is on record number 5 the progress form will not be repainted because the percentage is already set at 0% complete. Hope this makes sense. My first version of this repainted the progress bar with every record and it took really really long. The code for this is the 3rd section of code that i put in the first post.

PauseProgramInSeconds is just used to show that the loading of record set is complete for 1 secord or whatever.

I will post the modules if anyone is interested.

Hooks

 

[WayneRyan]

Hooks,

Maybe a little sample db in the Sample Database forum?

Wayne

 

[hooks]

Ok

Ill Post one later today or tomorrow.

 

[hooks]

Posted sample in the Sample Database forum.

Please give feedback as i want to make this a better progress bar that can be easily implemented in any access database.

Hooks

 

[WayneRyan]

Hooks,

I didn't want to clutter up post in the Sample DB forum, so I'll post
here.

Your Progress bar looks fine. I pointed it at one of my tables with
about 5,000 records. I had to put some "busy work" in the loop to
slow it down.

One comment though, the following line in ProgressBarUpdate errored:

dblPercentProcessed = Format$(dblPercent * 100, "##")

I changed it to:

dblPercentProcessed = Int(dblPercent * 100)

Didn't expect the double to receive the Format$ output.

Looks good tho,

One last thought ...

This is a linear mapping of a recordset traversal. How can you change
it to monitor a process: Import Table1 --> Import Table2 --> Run Report

Does the Progress Bar require any knowledge of the app? Or should some
caller just feed it a % complete, display color and maybe some text.

Interesting topic. Don't Progress Bars much, but if you're pushing
large amounts of data around, they're vital.

Wayne

 

[hooks]

Good question Wayne. I am planning on making a status bar for bound queries and reports. I'll post it in the samples section when and if i get it done.

It has been awhile since i worked with this status bar but i beleive all you have to pass to it is the maximum count of records (In my case) or I guess you could pass it the total number or steps while also passing the current record or step. It should be able to calculate the status bar with anything that you have a current count and a maximum count of. I think

I have some unbound reports that take forever to load, Like 15 minutes (By the way don't ever work with pictures in access. It is not worth the pain. It can be done but i would recommend letting someone else do it.) These reports have to get pictures off of a network server and it takes time. Anyway this would be perfect for a status bar.

Actually I never use a status bar but i got bored one night and decided that i would try to build a generic one just in case i needed one for my personnal mdbs.

Also

dblPercentProcessed = Format$(dblPercent * 100, "##")

I changed it to:

dblPercentProcessed = Int(dblPercent * 100)

That makes a lot of sense although it doesn't error out on me. I will change it though. I also plan on changing the variable names to make more sense.


One last thing Wayne. This is probably a stupid question but how do you make a parameter not required. I figured theres a way to do it but couldn't figure it out. This status bar has a lot a parameters that the programmer shouldn't have to figure out if he/she doesn't want to.

Thanks Hooks

 

[cable]

use the optional keyword.

ie myfunct(param1 as string, optional param2 as variant)

they have to be variants, and the last paramaters in the definition.

You can then use IsMissing(paramname) to check if it was passed or not.

 

[hooks]

Thanks Cable. I figured it was something simple.

Hooks