none
progress bar issue RRS feed

  • Question

  • Hi All

    How to correct the code below to show the progress bar properly?

    Currently my Progress bar ends with the view like this:


    To work properly it should end with "100% Completed" and of course the blue bar should reach the end, but it doesn't.


    The code in UserForm module:


    Private Sub UserForm_Activate()

    Dim WS As Worksheet
    Dim QTCount As Long
    Dim QT As QueryTable

    For Each WS In ThisWorkbook.Worksheets
    QTCount = QTCount + WS.QueryTables.Count
    'Set the Max value of the progress bar
    Next

    QTCount = 0

    For Each WS In ThisWorkbook.Worksheets
    For Each QT In WS.QueryTables
    QT.Refresh False
    QTCount = QTCount + 1
    'Update the progress bar
    UpdateProgressBar (QTCount)

    Next
    Next

    End Sub


    and the code updating progress bar:


    Sub UpdateProgressBar(QTCount As Single)

    UserForm1.Text.Caption = QTCount & "% Completed"
     UserForm1.Bar.Width = QTCount * 2

     DoEvents

    End Sub

    I have got 11 QueryTables in my Workbook. Each one i separate Worksheet.

    I guess the line:

    UserForm1.Text.Caption = QTCount & "% Completed"

    might it looks like this:

    UserForm1.Text.Caption = QTCount  / QTCountMax & "% Completed"

    where

    QTCountMax = number of query tables in workbook

    As far bar width, similar approach.

    I have no idea how to correct this



    Saturday, February 14, 2015 12:57 PM

Answers

  • Assuming that the frame control is named Frame, try this:

    Private Sub UserForm_Activate()
        Dim WS As Worksheet
        Dim QTCount As Long
        Dim QT As QueryTable
        Dim i As Long
    
        For Each WS In ThisWorkbook.Worksheets
            QTCount = QTCount + WS.QueryTables.Count
        Next WS
    
        Me.Bar.Width = 0
        For Each WS In ThisWorkbook.Worksheets
            For Each QT In WS.QueryTables
                QT.Refresh False
                i = i + 1
                'Update the progress bar
                UpdateProgressBar i, QTCount
            Next QT
        Next WS
    End Sub
    
    Sub UpdateProgressBar(i As Long, QTCount As Long)
        With UserForm1
            .Text.Caption = Format(i / QTCount, "0%") & " Completed"
            .Bar.Width = i / QTCount * (.Frame.Width - 2)
            .Repaint
        End With
        DoEvents
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Saturday, February 14, 2015 3:08 PM

All replies

  • What type of control is "Bar"?

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Saturday, February 14, 2015 2:02 PM
  • Hi Hans

    "Bar" is a Label control inside of a Frame control

    Saturday, February 14, 2015 2:47 PM
  • Assuming that the frame control is named Frame, try this:

    Private Sub UserForm_Activate()
        Dim WS As Worksheet
        Dim QTCount As Long
        Dim QT As QueryTable
        Dim i As Long
    
        For Each WS In ThisWorkbook.Worksheets
            QTCount = QTCount + WS.QueryTables.Count
        Next WS
    
        Me.Bar.Width = 0
        For Each WS In ThisWorkbook.Worksheets
            For Each QT In WS.QueryTables
                QT.Refresh False
                i = i + 1
                'Update the progress bar
                UpdateProgressBar i, QTCount
            Next QT
        Next WS
    End Sub
    
    Sub UpdateProgressBar(i As Long, QTCount As Long)
        With UserForm1
            .Text.Caption = Format(i / QTCount, "0%") & " Completed"
            .Bar.Width = i / QTCount * (.Frame.Width - 2)
            .Repaint
        End With
        DoEvents
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Saturday, February 14, 2015 3:08 PM
  • Thanks Hans

    Works great !

    Saturday, February 14, 2015 9:20 PM