Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Progress
I've tried to use the 'progress indicator' to update on a peace of code.
Thing is, in the exercise (from J. Walkenbach) the Main procedure adds random numbers. What I would like to do is whenever I activate commandbutton1 or commandbutton2 (both buttons to be found in userform2) the progress inidcator pops up. I however have no singel clue how to get about. I enclosed a copy of my file. Sheet TrimAll = where all the action happens Sheet2 = Not used Sheet3 = Not used Userform1 pops up whenever you select the sheet. It asks the user if he/she wants to delete HTML non-breaking spaces or not. If the user chooses to delete the HTML non-breaking spaces Userform2 turns on. In this Userform (2) the user can decide wether to adjust the whole package of data or just a selection (using an inputbox). Now comes the tricky part (to me); in both cases (so whenever a user chooses to adjust everything or just a selection) I'd like to have a progress indicator displayed to them. Can you help me with this (or just get me started)?! I you need code referring to commandbutton 1 and 2, see below Private Sub CommandButton1_Click() Application.DisplayAlerts = True Application.EnableEvents = True 'should be part of Change Event macro If Application.Calculation = xlCalculationManual Then MsgBox "Calculation was OFF will be turned ON upon completion" End If Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'Select active content Range("A2").CurrentRegion.Select Dim cell As Range 'Also Treat CHR 0160, as a space (CHR 032) Selection.Replace What:=Chr(160), Replacement:=Chr(32), _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False 'Trim in Excel removes extra internal spaces, VBA does not On Error Resume Next 'in case no text cells in selection For Each cell In Intersect(Selection, _ Selection.SpecialCells(xlConstants, xlTextValues)) cell.Value = Application.Trim(cell.Value) Next cell On Error GoTo 0 Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub Private Sub CommandButton2_Click() Dim rng As Range On Error Resume Next Specify = Application.InputBox _ (prompt:="Specify a range", Type:=8).Select Dim cell As Range 'Also Treat CHR 0160, as a space (CHR 032) Selection.Replace What:=Chr(160), Replacement:=Chr(32), _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False 'Trim in Excel removes extra internal spaces, VBA does not On Error Resume Next 'in case no text cells in selection For Each cell In Intersect(Selection, _ Selection.SpecialCells(xlConstants, xlTextValues)) cell.Value = Application.Trim(cell.Value) Next cell On Error GoTo 0 Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub Private Sub CommandButton3_Click() Unload UserForm2 End Sub Private Sub UserForm_Click() End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Progress
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Progress
You are welcome so far.
You have to tell the progress bar how wide it should be... Everything = TheDoughnut.Cells.Count For Each Hole in TheDoughNut.Cells 'Take a bite Bite = Bite + 1 AmountEaten = Bite/Everything Call UpdateProgress(AmountEaten) Next -- Jim Cone Portland, Oregon USA "Basta1980" wrote in message Jim, Thanks so far. Due to your information i changed a bit in the code and yes it did help. The only thing is, I don't see the progress indicator update (so the sub Main() works and I see the progress indicator). Option Explicit Sub Start() ' The UserForm1_Activate sub calls Main UserForm1.LabelProgress.Width = 0 UserForm1.Show End Sub Sub Main() Range("A2").CurrentRegion.Select Dim cell As Range 'Also Treat CHR 0160, as a space (CHR 032) Selection.Replace What:=Chr(160), Replacement:=Chr(32), _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False 'Trim in Excel removes extra internal spaces, VBA does not On Error Resume Next 'in case no text cells in selection For Each cell In Intersect(Selection, _ Selection.SpecialCells(xlConstants, xlTextValues)) cell.Value = Application.Trim(cell.Value) Next cell Unload UserForm1 End Sub Sub UpdateProgress(pct) With UserForm1 .FrameProgress.Caption = Format(pct, "0%") .LabelProgress.Width = pct * (.FrameProgress _ .Width - 10) End With ' The DoEvents statement is responsible for the form updating DoEvents End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Progress
Jim,
I suppose Everything = TheDoughnut.Cells.Count For Each Hole in TheDoughNut.Cells 'Take a bite Bite = Bite + 1 AmountEaten = Bite/Everything Call UpdateProgress(AmountEaten) Next Comes in the sub Main()?! Regards Bas "Jim Cone" wrote: You are welcome so far. You have to tell the progress bar how wide it should be... Everything = TheDoughnut.Cells.Count For Each Hole in TheDoughNut.Cells 'Take a bite Bite = Bite + 1 AmountEaten = Bite/Everything Call UpdateProgress(AmountEaten) Next -- Jim Cone Portland, Oregon USA "Basta1980" wrote in message Jim, Thanks so far. Due to your information i changed a bit in the code and yes it did help. The only thing is, I don't see the progress indicator update (so the sub Main() works and I see the progress indicator). Option Explicit Sub Start() ' The UserForm1_Activate sub calls Main UserForm1.LabelProgress.Width = 0 UserForm1.Show End Sub Sub Main() Range("A2").CurrentRegion.Select Dim cell As Range 'Also Treat CHR 0160, as a space (CHR 032) Selection.Replace What:=Chr(160), Replacement:=Chr(32), _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False 'Trim in Excel removes extra internal spaces, VBA does not On Error Resume Next 'in case no text cells in selection For Each cell In Intersect(Selection, _ Selection.SpecialCells(xlConstants, xlTextValues)) cell.Value = Application.Trim(cell.Value) Next cell Unload UserForm1 End Sub Sub UpdateProgress(pct) With UserForm1 .FrameProgress.Caption = Format(pct, "0%") .LabelProgress.Width = pct * (.FrameProgress _ .Width - 10) End With ' The DoEvents statement is responsible for the form updating DoEvents End Sub |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Progress
'Add the following...
Set rng = Application.Intersect(Selection, _ Selection.SpecialCells(xlConstants, xlTextValues)) NumCells = rng.Count 'Replace this... For Each cell In Intersect(Selection, _ Selection.SpecialCells(xlConstants, xlTextValues)) cell.Value = Application.Trim(cell.Value) Next cell 'With this... For Each cell In rng.Cells cell.Value = Application.Trim(cell.Value) NumCount = NumCount + 1 Call UpdateProgress(NumCount/NumCells) Next cell -- Jim Cone Portland, Oregon USA "Basta1980" wrote in message Jim, I suppose Everything = TheDoughnut.Cells.Count For Each Hole in TheDoughNut.Cells 'Take a bite Bite = Bite + 1 AmountEaten = Bite/Everything Call UpdateProgress(AmountEaten) Next Comes in the sub Main()?! Regards Bas |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
progress bar for XML | Excel Programming | |||
NEED Help - How to capture the Event's progress in Progress Bar | Excel Programming | |||
Progress Bar ? | Excel Programming | |||
Progress Bar | Excel Programming | |||
Progress Bar Help | Excel Programming |