Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Statusbar
Hi,
I've taken this code from one of the samples available on another website. In the below sample code, how do i determine/translate the "# of items to process" for my project. There are upto 17 diff worksheets on my current project & on opening the workbook there are linking/updations/calculations that are done automatically. With the code as it is, the status bar work fine, but the progress indicator runs quicker than the actual time that it takes for the entire updation to happen. Thsi needs to work cos I've decide to stop the screen flicker as well. I need the status bar to be in sync with the actual time that the updation takes. please advice Code being used Option Explicit Sub TestBar() Dim MyTot As Long, i As Long, j As Integer Application.ScreenUpdating = False ' speed up the macro Sheets(1).Select ' has records to process MyTot = 5000 ' # of items to process i = 0 ' sets startvalue for your index While i < MyTot ' start your While .. Wend, Do .. Loop or For .. Next i = i + 1 ' increase your index / activate your next item StatBar i, MyTot, "Processing", True ' display statusbar For j = 1 To 10000: Next j ' remove this line from your code to speed up processing ' do something ... ' do something else ... Wend ' start processing next item Application.StatusBar = False ' remove statusbartext End Sub Sub StatBar(MyIndex As Long, MyTotal As Long, MyText As String, InclPercent As Boolean) Const NumBars As Integer = 30 ' # of characters in the bar Const FillChar As String * 1 = "€¢" ' alt+0149 or try out your own character Const DoneChar As String * 1 = "»" ' alt+0187 or try out your own character Dim PctDone As Integer, FBar As Integer, BBar As Integer, BarText As String If MyIndex Mod CInt((MyTotal * 0.01)) < 0 Then Exit Sub ' previous line speeds up the macro by not updating the statusbar for every single record If MyText < Empty Then BarText = MyText & " " Else BarText = Empty PctDone = CInt((MyIndex / MyTotal) * 100) FBar = CInt(PctDone / 100 * NumBars) BBar = NumBars - FBar If InclPercent Then BarText = BarText & " " & PctDone & " % " End If Application.StatusBar = BarText & Application.Rept(DoneChar, FBar) & Application.Rept(FillChar, BBar) End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Statusbar
Here is what I do: Trial and Error. I determine the "mostly likely"
scenario of what data will get processed and then I call a function by setting up a couple public variables: Private Function UpdateUF1(pctdone As Double, Caption As String) 'this updates the progress bar ont he first update progress box. On Error GoTo 0 With UserForm1 If pctdone 1 Then pctdone = 1 - 0.02 End If .FrameProgress.Caption = Format(pctdone, "0%") .LabelProgress.Width = pctdone * (.FrameProgress.Width - 10) .Label1.Caption = Caption End With DoEvents End Function Then if the thing finishes too fast, as you say, I adjust the way I build up the value of PCTDONE. Then I run it again until it is about right. And if there are options that the user can select which affects the iterations of running stuff, I try to take that into account and adjust accordingly also. Also, note, if I get above 1, I pare it back to 98%. Good luck! I have mine where they are what I'd call perfect. Actually much better than the progress bars you get with a lot of stuff! "Matts" wrote: Hi, I've taken this code from one of the samples available on another website. In the below sample code, how do i determine/translate the "# of items to process" for my project. There are upto 17 diff worksheets on my current project & on opening the workbook there are linking/updations/calculations that are done automatically. With the code as it is, the status bar work fine, but the progress indicator runs quicker than the actual time that it takes for the entire updation to happen. Thsi needs to work cos I've decide to stop the screen flicker as well. I need the status bar to be in sync with the actual time that the updation takes. please advice Code being used Option Explicit Sub TestBar() Dim MyTot As Long, i As Long, j As Integer Application.ScreenUpdating = False ' speed up the macro Sheets(1).Select ' has records to process MyTot = 5000 ' # of items to process i = 0 ' sets startvalue for your index While i < MyTot ' start your While .. Wend, Do .. Loop or For .. Next i = i + 1 ' increase your index / activate your next item StatBar i, MyTot, "Processing", True ' display statusbar For j = 1 To 10000: Next j ' remove this line from your code to speed up processing ' do something ... ' do something else ... Wend ' start processing next item Application.StatusBar = False ' remove statusbartext End Sub Sub StatBar(MyIndex As Long, MyTotal As Long, MyText As String, InclPercent As Boolean) Const NumBars As Integer = 30 ' # of characters in the bar Const FillChar As String * 1 = "€¢" ' alt+0149 or try out your own character Const DoneChar As String * 1 = "»" ' alt+0187 or try out your own character Dim PctDone As Integer, FBar As Integer, BBar As Integer, BarText As String If MyIndex Mod CInt((MyTotal * 0.01)) < 0 Then Exit Sub ' previous line speeds up the macro by not updating the statusbar for every single record If MyText < Empty Then BarText = MyText & " " Else BarText = Empty PctDone = CInt((MyIndex / MyTotal) * 100) FBar = CInt(PctDone / 100 * NumBars) BBar = NumBars - FBar If InclPercent Then BarText = BarText & " " & PctDone & " % " End If Application.StatusBar = BarText & Application.Rept(DoneChar, FBar) & Application.Rept(FillChar, BBar) End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Statusbar
Hi Mike,
I do not have a Userform on this workbook atall. I see the progree bar happenening on the bottom of the screen. How does your code change now ? "Mike H." wrote: Here is what I do: Trial and Error. I determine the "mostly likely" scenario of what data will get processed and then I call a function by setting up a couple public variables: Private Function UpdateUF1(pctdone As Double, Caption As String) 'this updates the progress bar ont he first update progress box. On Error GoTo 0 With UserForm1 If pctdone 1 Then pctdone = 1 - 0.02 End If .FrameProgress.Caption = Format(pctdone, "0%") .LabelProgress.Width = pctdone * (.FrameProgress.Width - 10) .Label1.Caption = Caption End With DoEvents End Function Then if the thing finishes too fast, as you say, I adjust the way I build up the value of PCTDONE. Then I run it again until it is about right. And if there are options that the user can select which affects the iterations of running stuff, I try to take that into account and adjust accordingly also. Also, note, if I get above 1, I pare it back to 98%. Good luck! I have mine where they are what I'd call perfect. Actually much better than the progress bars you get with a lot of stuff! "Matts" wrote: Hi, I've taken this code from one of the samples available on another website. In the below sample code, how do i determine/translate the "# of items to process" for my project. There are upto 17 diff worksheets on my current project & on opening the workbook there are linking/updations/calculations that are done automatically. With the code as it is, the status bar work fine, but the progress indicator runs quicker than the actual time that it takes for the entire updation to happen. Thsi needs to work cos I've decide to stop the screen flicker as well. I need the status bar to be in sync with the actual time that the updation takes. please advice Code being used Option Explicit Sub TestBar() Dim MyTot As Long, i As Long, j As Integer Application.ScreenUpdating = False ' speed up the macro Sheets(1).Select ' has records to process MyTot = 5000 ' # of items to process i = 0 ' sets startvalue for your index While i < MyTot ' start your While .. Wend, Do .. Loop or For .. Next i = i + 1 ' increase your index / activate your next item StatBar i, MyTot, "Processing", True ' display statusbar For j = 1 To 10000: Next j ' remove this line from your code to speed up processing ' do something ... ' do something else ... Wend ' start processing next item Application.StatusBar = False ' remove statusbartext End Sub Sub StatBar(MyIndex As Long, MyTotal As Long, MyText As String, InclPercent As Boolean) Const NumBars As Integer = 30 ' # of characters in the bar Const FillChar As String * 1 = "€¢" ' alt+0149 or try out your own character Const DoneChar As String * 1 = "»" ' alt+0187 or try out your own character Dim PctDone As Integer, FBar As Integer, BBar As Integer, BarText As String If MyIndex Mod CInt((MyTotal * 0.01)) < 0 Then Exit Sub ' previous line speeds up the macro by not updating the statusbar for every single record If MyText < Empty Then BarText = MyText & " " Else BarText = Empty PctDone = CInt((MyIndex / MyTotal) * 100) FBar = CInt(PctDone / 100 * NumBars) BBar = NumBars - FBar If InclPercent Then BarText = BarText & " " & PctDone & " % " End If Application.StatusBar = BarText & Application.Rept(DoneChar, FBar) & Application.Rept(FillChar, BBar) End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Statusbar
You have the same thing. In your case the entire issue becomes what is the
value of i that you are passing (MyIndex when passed) because i is the numerator in your calculation. So you just have to vary the way you increment it. Not very scientific but that is truly all you have to do. Maybe you have to reduct how fast it increments or increase the size of the denominator, MyTotal. HTH "Matts" wrote: Hi Mike, I do not have a Userform on this workbook atall. I see the progree bar happenening on the bottom of the screen. How does your code change now ? "Mike H." wrote: Here is what I do: Trial and Error. I determine the "mostly likely" scenario of what data will get processed and then I call a function by setting up a couple public variables: Private Function UpdateUF1(pctdone As Double, Caption As String) 'this updates the progress bar ont he first update progress box. On Error GoTo 0 With UserForm1 If pctdone 1 Then pctdone = 1 - 0.02 End If .FrameProgress.Caption = Format(pctdone, "0%") .LabelProgress.Width = pctdone * (.FrameProgress.Width - 10) .Label1.Caption = Caption End With DoEvents End Function Then if the thing finishes too fast, as you say, I adjust the way I build up the value of PCTDONE. Then I run it again until it is about right. And if there are options that the user can select which affects the iterations of running stuff, I try to take that into account and adjust accordingly also. Also, note, if I get above 1, I pare it back to 98%. Good luck! I have mine where they are what I'd call perfect. Actually much better than the progress bars you get with a lot of stuff! "Matts" wrote: Hi, I've taken this code from one of the samples available on another website. In the below sample code, how do i determine/translate the "# of items to process" for my project. There are upto 17 diff worksheets on my current project & on opening the workbook there are linking/updations/calculations that are done automatically. With the code as it is, the status bar work fine, but the progress indicator runs quicker than the actual time that it takes for the entire updation to happen. Thsi needs to work cos I've decide to stop the screen flicker as well. I need the status bar to be in sync with the actual time that the updation takes. please advice Code being used Option Explicit Sub TestBar() Dim MyTot As Long, i As Long, j As Integer Application.ScreenUpdating = False ' speed up the macro Sheets(1).Select ' has records to process MyTot = 5000 ' # of items to process i = 0 ' sets startvalue for your index While i < MyTot ' start your While .. Wend, Do .. Loop or For .. Next i = i + 1 ' increase your index / activate your next item StatBar i, MyTot, "Processing", True ' display statusbar For j = 1 To 10000: Next j ' remove this line from your code to speed up processing ' do something ... ' do something else ... Wend ' start processing next item Application.StatusBar = False ' remove statusbartext End Sub Sub StatBar(MyIndex As Long, MyTotal As Long, MyText As String, InclPercent As Boolean) Const NumBars As Integer = 30 ' # of characters in the bar Const FillChar As String * 1 = "€¢" ' alt+0149 or try out your own character Const DoneChar As String * 1 = "»" ' alt+0187 or try out your own character Dim PctDone As Integer, FBar As Integer, BBar As Integer, BarText As String If MyIndex Mod CInt((MyTotal * 0.01)) < 0 Then Exit Sub ' previous line speeds up the macro by not updating the statusbar for every single record If MyText < Empty Then BarText = MyText & " " Else BarText = Empty PctDone = CInt((MyIndex / MyTotal) * 100) FBar = CInt(PctDone / 100 * NumBars) BBar = NumBars - FBar If InclPercent Then BarText = BarText & " " & PctDone & " % " End If Application.StatusBar = BarText & Application.Rept(DoneChar, FBar) & Application.Rept(FillChar, BBar) End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
FIX in Statusbar | Excel Discussion (Misc queries) | |||
Statusbar | Excel Programming | |||
StatusBar Progress | Excel Programming | |||
Get the string of the statusbar | Excel Programming | |||
StatusBar Msg? | Excel Programming |