Progress bar that goes from 0 to 100 in ten seconds - WORKING!

[JJFletcher]

Hi Everyone,

I would like to know where to get samples of a Progress Bar Macro that goes from 0 to 100 in ten seconds

Any Thoughts???


Best Regards,


John

[djbomaha]

Hi,

The attached workbook has a simple progress bar example in the VBA editor. It just advances after delaying a second through 10 cycles.

Hope it provides some direction,

Dan

[JJFletcher]

Hi DJBOHAMA,

Thanks so much for getting this to me - I appreciate this.. I will see if it provides the results I am needing!

Best Regards,

John

[JJFletcher]

Solution is found...

I want to thank everyone in the Forum... Such a Rich Treasure of Knowledge and willingness to help is absolutely AWESOME!

Working Progressbar that loads within 10 seconds: This first Code is the ProgressDlg.frm - When sizing the Form I hide the square progress boxes...

Private Sub UserForm_Activate()
    Call Main
End Sub

Private Sub UserForm_Initialize()
    With Me.lblDone ' set the "progress bar" to it's initial length
        .Top = Me.lblRemain.Top + 1
        .Left = Me.lblRemain.Left + 1
        .Height = Me.lblRemain.Height - 2
        .Width = 246
    End With
End Sub
Sub Main()
Dim i As Long, tot As Long
    tot = 300000
    ProgressDlg.Caption = "Loading Quality Production Tool..."
    For i = 1 To tot
        If i Mod 5 = 0 Then ProgressBar i / tot
        Next i
    Unload ProgressDlg
End Sub
Sub ProgressBar(PctDone As Single)
    With ProgressDlg
        .lblDone.Width = PctDone * (.lblRemain.Width - 2)
        .lblPct.Caption = Format(PctDone, "0%")
    End With
    'The DoEvents statement is responsible for the form updating
    Select Case ProgressDlg.lblPct.Caption
    Case "10%"
        ProgressDlg.Frame1.Visible = True
       
    Case "20%"
        ProgressDlg.Frame2.Visible = True
     
     
    Case "30%"
        ProgressDlg.Frame3.Visible = True
        
      
    Case "40%"
       ProgressDlg.Frame4.Visible = True
              
    Case "50%"
       ProgressDlg.Frame5.Visible = True
              
    Case "60%"
        ProgressDlg.Frame6.Visible = True
        
    Case "70%"
     ProgressDlg.Frame7.Visible = True
       
    Case "80%"
     ProgressDlg.Frame8.Visible = True
        
        
    Case "90%"
       ProgressDlg.Frame9.Visible = True
        
     
    Case "100%"
      ProgressDlg.Frame10.Visible = True
                
    End Select
    DoEvents
    
End Sub

Hide Sheet Module :

Option Private Module
Sub Hide_Sheet()
    Sheet1.Visible = True
    Sheet2.Visible = False

End Sub

In ThisWorkbook add this code:

  Private Sub Workbook_Open()

  Application.OnTime Now + TimeValue("00:00:10"), "Hide_Sheet"
    
    ProgressDlg.Show
    
 End Sub

This works Great

Best Regards,

John

[YasserKhalil]

A little fix for code in Post # 2

Private Sub UserForm_Activate()
    Dim I As Integer
    
    frameProgress.Caption = ""
    lblProgress.Width = 0

    For I = 1 To 10
        Application.Wait (Now + TimeValue("00:00:01"))
        lblProgress.Width = (I * 10 / 100) * frameProgress.Width
        frameProgress.Caption = I * 10 & " of 100"
        frameProgress.Repaint

        If (I = 1) Then
            lblProg.Caption = I & " Second"
        Else
            lblProg.Caption = I & " Seconds"
        End If
    Next I
    Unload frmProgressBar
End Sub

The fix is using this line with label

 frameProgress.Repaint

[JJFletcher]

Awesome Yasser,

This is Great thanks much....


Say, Maybe you can look at my new post regarding hiding the TAB on the sheet...

Post - Can the TAB (Sheet Name) at the bottom of the worksheet really be hidden with this Code??


The guys there say it should work... I tried it and it does not work...

Best Regards,

John