Results 1 to 5 of 5
  1. #1
    Join Date
    Jan 2012
    Location
    India
    Posts
    42

    Question Answered: Progress bar conditional issue

    hi all,

    I made one Progress Bar for some forms and use it from those forms. Everything works, but not simultaneously.

    Can anyone help me to work them simultaneously?


    Progress bar code on 'frmProgressMeter' :

    Option Compare Database
    Option Explicit
    Dim mod_TopLimit As Long
    Dim mod_Step As Long
    Dim mod_Current_Pos As Long

    Public Property Let TopLimit(nLimit As Long)
    mod_TopLimit = nLimit
    mod_Step = txtProgressBar.Width \ nLimit
    txtProgressBar.Width = 0
    lblCompleted.Caption = "0%"
    End Property

    Public Property Let Current_pos(nPos As Long)
    txtProgressBar.Width = mod_Step * nPos
    mod_Current_Pos = mod_Current_Pos + 1
    If nPos / mod_TopLimit <= 1 Then
    lblCompleted.Caption = Format(nPos / mod_TopLimit, "0 % Completed")
    End If
    DoEvents
    Me.Repaint
    End Property

    Public Property Get Current_pos() As Long
    Current_pos = mod_Current_Pos
    End Property

    Public Sub CloseMe()
    DoCmd.Close acForm, Me.NAME
    End Sub

    Private Sub Form_Load()
    Dim fi As ModFormInfo
    Set fi = New ModFormInfo
    Set fi.Form = Me
    fi.ShowCaptionBar = False
    End Sub

    ----------------------
    Functional code for Progress Bar:

    Option Compare Database
    Option Explicit
    Private Declare Sub sapiSleep Lib "kernel32" _
    Alias "Sleep" _
    (ByVal dwMilliseconds As Long)

    Function IsLoaded(FrmName As String) As Boolean
    Dim i As Integer
    IsLoaded = False
    For i = 0 To Forms.count - 1
    If Forms(i).NAME = FrmName Then
    IsLoaded = True
    Exit Function
    End If
    Next i
    End Function

    Sub OpenProgressBar(nTopLimit As Long, strCaption As String)
    If nTopLimit > 0 Then
    DoCmd.OpenForm "FrmProgressMeter", OpenArgs:=strCaption
    Forms("FrmProgressMeter").TopLimit = nTopLimit
    End If
    End Sub

    Function SetProgressBar(nCurrent_Pos As Long) As Long
    If IsLoaded("FrmProgressMeter") Then
    Forms("FrmProgressMeter").Current_pos = nCurrent_Pos
    SetProgressBar = Forms("FrmProgressMeter").Current_pos()
    DoEvents
    End If
    End Function

    Sub CloseProgressBar()
    If IsLoaded("FrmProgressMeter") Then
    Forms("FrmProgressMeter").CloseMe
    End If
    End Sub

    Function NormalProgressBar()
    Dim n As Long
    OpenProgressBar 100, "Completed"
    For n = 1 To 100
    sSleep 10
    SetProgressBar n
    Next n
    sSleep 2000
    CloseProgressBar
    End Function

    Function LongProgressBar()
    Dim n As Long
    OpenProgressBar 100, "Completed"
    For n = 1 To 100
    sSleep 100
    SetProgressBar n
    Next n
    sSleep 10000
    CloseProgressBar
    End Function

    Sub sSleep(lngMilliSec As Long)
    If lngMilliSec > 0 Then
    Call sapiSleep(lngMilliSec)
    End If
    End Sub

    ---------------------------

    Code on the other form (Database Switcher) from where I use Progress Bar :

    Private Sub cmdDisconnect_Click()
    On Error GoTo Err_cmdDisconnect_Click

    Dim dbs As DAO.Database
    Dim tdf As DAO.TableDef
    Dim strDatabaseName As String
    Dim File As String
    Dim retval

    Set dbs = CurrentDb()
    File = "Data" & Format(StartDate, "yy") & Format(EndDate, "yy") & ".accdb" '(Output = Data1516.accdb)
    strDatabaseName = Folderpath & "\" & File

    If strDatabaseName = DBPath Then
    MsgBox "Auto Evolution is already connected to its current database.", vbInformation, "Connecttion Error"
    Me.Dbase.SetFocus
    Exit Sub
    End If

    If Dir(strDatabaseName) = "" Then
    MsgBox "The Auto Evolution database you have specified as the " & _
    "source was not found.", vbInformation, "Connection Error"
    Exit Sub
    End If

    DoCmd.Hourglass True
    Me.CmdClose.Enabled = False
    Me.cmdConnect.Enabled = False
    Me.Dbase.Enabled = False
    Me.CmdDisconnect.Enabled = False
    retval = SysCmd(acSysCmdSetStatus, "Connecting to current Database")

    For Each tdf In dbs.TableDefs
    If tdf.Connect <> "" Then
    tdf.Connect = ";DATABASE=" & strDatabaseName & (";PWD=zujan")
    tdf.RefreshLink
    End If
    Next tdf

    Call NormalProgressBar 'Progress Bar process

    DoCmd.Hourglass False
    retval = SysCmd(acSysCmdClearStatus)

    MsgBox "The Auto Evolution database is connected with " & _
    "'" & File & "'.", vbInformation, "Connection Successful"
    DoCmd.Close acForm, Me.NAME

    Exit_cmdDisconnect_Click:
    Exit Sub

    Err_cmdDisconnect_Click:
    DoCmd.Hourglass False
    If Err.Number <> 2467 Then
    MsgBox ("Unable to execute database switch now."), vbCritical, "Error"
    Me.CmdClose.Enabled = True
    Me.cmdConnect.Enabled = True
    Me.Dbase.Enabled = True
    Me.CmdDisconnect.Enabled = True
    Resume Exit_cmdDisconnect_Click
    End If
    End Sub

  2. Best Answer
    Posted by healdem

    "to improve performance Access like the rest of the VBA applications and VB supresses screen repaints id in the compilers view there is no need for a\ creen update.

    as ranman256 saya use a do events to force a screen repioant after your progress bar changes position/value. but I'd suggest you do it sparingly. if say the process runs for 1000 cycles, update the screen (progress bar) after say 50 cycles or 5% as opposed to after every cycle. There is a trade off between the processor time take to repaint the screen and the processor time expneded on the actual process. a progress bar is more of a reminder to the user that a processor intensive action, or one that requires no user input, is active and the computer is 'happily' working on the program and hasn't frozen."


  3. #2
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    496
    Provided Answers: 24
    After the bar change, run a DOEVENTS.

  4. #3
    Join Date
    Jan 2012
    Location
    India
    Posts
    42
    thanks for your quick reply, but can you be in detail or type some codes for me.

    Regards,
    Anuj

  5. #4
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    to improve performance Access like the rest of the VBA applications and VB supresses screen repaints id in the compilers view there is no need for a\ creen update.

    as ranman256 saya use a do events to force a screen repioant after your progress bar changes position/value. but I'd suggest you do it sparingly. if say the process runs for 1000 cycles, update the screen (progress bar) after say 50 cycles or 5% as opposed to after every cycle. There is a trade off between the processor time take to repaint the screen and the processor time expneded on the actual process. a progress bar is more of a reminder to the user that a processor intensive action, or one that requires no user input, is active and the computer is 'happily' working on the program and hasn't frozen.
    I'd rather be riding on the Tiger 800 or the Norton

  6. #5
    Join Date
    Jan 2012
    Location
    India
    Posts
    42
    Thanks healdem and ranman256 for your help.

Posting Permissions

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