Userform with progress bar changing colours

[Suril]

I know there is no practical utility as such in this but it would be really cool if im able to do this.. I have a userform with progress bar.. I was thinking if it is possible that the progress bar changes its colour - eg: by default it is blue.. which changes to green once 90% is done..

 

[Marc L]

You just have to test the % rate and modify the bar BackColor property …​

 

[Suril]

had done that earlier... doesnt work

 

[Marc L]

And yet it seems the only way … Works on mine …​

 

[Abhijeet R. Joshi]

I had tried this earlier, this is not changing colors but a regular progress bar..trying referencing it...

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const PI = 3.14159265358979
Sub DemoProgress1()
 
    Dim intIndex As Integer
    Dim sngPercent As Single
    Dim intMax As Integer
   
    intMax = 100
    For intIndex = 1 To intMax
        sngPercent = intIndex / intMax
        ProgressStyle1 sngPercent, chkPg1Value.Value
        DoEvents
        '------------------------
        ' Your code would go here
        '------------------------
        Sleep 100
    Next
 
End Sub
Sub ProgressStyle1(Percent As Single, ShowValue As Boolean)
 
    Const PAD = "                        "
    If ShowValue Then
        labPg1v.Caption = PAD & Format(Percent, "0%")
        labPg1va.Caption = labPg1v.Caption
        labPg1va.Width = labPg1.Width
    End If
    labPg1.Width = Int(labPg1.Tag * Percent)
End Sub
 
Private Sub MultiPage1_Change()
 
End Sub
 
Private Sub UserForm_Initialize()
    labPg1.Tag = labPg1.Width
    labPg1.Width = 0
    labPg1v.Caption = ""
    labPg1va.Caption = ""
    Label10_Click
End Sub
 
Sub Label10_Click()
    Dim strMsg As String
    strMsg = "HELP TIPS :" & vbLf & vbLf
    strMsg = strMsg & "The Progress Bar shows the % completion of the Macro." & vbLf
    strMsg = strMsg & "Please do not use the System unless the Macro is 100& completed." & vbLf
    strMsg = strMsg & "Once the macro is 100% complete, you can close it." & vbLf
    labhelp01.Caption = strMsg
   
End Sub
Private Sub chkPg1Value_Click()
    labPg1v.Visible = chkPg1Value.Value
    labPg1va.Visible = chkPg1Value.Value
End Sub
 
Private Sub chkPg2Value_Click()
    labPg2v.Visible = chkPg2Value.Value
    labPg3v.Visible = chkPg2Value.Value
End Sub
Private Sub chkPg3Value_Click()
    Me.labPg3v.Visible = chkPg3Value.Value
End Sub
 
Private Sub CommandButton1_Click()
    Unload Me
End Sub
 
Private Sub CommandButton2_Click()
 
    Application.Cursor = xlWait
 
    Select Case MultiPage1.Value
    Case 0
        DemoProgress1
    End Select
    Application.Cursor = xlDefault
    MsgBox "Macro has run successfully"
End Sub

 

[ThrottleWorks]

Hi Suril,

I faced similar type of issue couple of months ago. Not able to find the thread.
I was trying to change the colors as macro progress, I was using multiple colors.

The problem was, my code was very simple, so it used to take just 2-3 seconds to run.
So even with application.screenupdating true, I was not able to "SEE" change in colors.

I thought it as a bug but Narayan Sir explained me this.
The colors were getting chaged but I was not able to notice this due to very short time of run.

My point is, if you can define the default color which is blue then please change the color to green before ending the macro.

Suppose you have 5 lines of code, at the end of Line 4, please change the color to green.
So at the start of macro, the progess bar will be blue, by the end it will turn in green.

Will this work ? Sorry if I am missing something.

 

[Marc L]

After updating color, use DoEvents or Repaint …​