huntson
asked on
How can I add a progress bar to this word macro
Another user on this site helped my optimize my code for a macro that modifies a subtitle file. I'd like to add a progress bar example I have found online. I'm not exactly sure how to make Word do 2 things at the same time. Perhaps the best approach is to encompass the main program in another loop that handles the progress bar?
Here is the main code:
Here is the progress bar code:
Here is the main code:
Sub RemoveParaOrLineBreaks()
'use constants here instead of variables
Const staticTC = "--:--:--:--:--,--:--:--:--:--,10"
Const static_next_line = "80 80 80"
'added this
Const marker_code = "C2N03"
Dim bStop As Boolean
'variant for previous and next slide number
Dim vSlide As Variant, vNext As Variant
'we need 3 range variables:
Dim rSlide As Range, rNext As Range, rDoc As Range
'start and end long integer markers for rSlide range:
Dim iStart As Long, iEnd As Long
'length of slide number line:
Dim iPos As Long
'variable to hold replacement text:
Dim sText As String
'initial setup
Set rDoc = ActiveDocument.Range
'create rSlide initially as zero size. NB do NOT initialise both rNext and rSlide to the whole document range as well, since
'this non-obviously makes them both the same range, and changing one will change the other
Set rSlide = ActiveDocument.Range(0, 0)
'set up the find parameters before you loop through the document, so you don't repeat unnecessary setup on each loop:
With rDoc.Find
.ClearFormatting
.Format = False
.Wrap = wdFindStop
.Forward = True
.MatchWildcards = False
End With
Do
'find the next (or first) slide, using carriage-return number number number number
With rDoc.Find
.Execute FindText:="^p^#^#^#^#"
If .found Then
'set end of previous slide range
rSlide.End = rDoc.Start - 1
'set range of rNext to the temporary values for rDoc that result from the "find", and then extend to include 4 more characters
Set rNext = ActiveDocument.Range(rDoc.Start, rDoc.End)
rNext.End = rNext.End + 4
'grab the resulting text to variable vNext
vNext = rNext.Text
'check the sixth character and include it as part of the slide number if it's not a space, using VBA string function Mid
If Mid(vNext, 6, 1) <> Chr(32) Then
vNext = Mid(vNext, 2, 5)
Else
'otherwise just use the first four characters (omitting the carriage return at the start)
vNext = Mid(vNext, 2, 4)
End If
'if no further slide numbers found, then exit at end of loop
Else
bStop = True
'set final slide range.. assuming text is in a table, as in your example, this needs to be the end of the table cell
'if text is not in a table then use activedocument.range.end-1
rSlide.End = rSlide.Cells(1).Range.End - 2
End If
End With
'process the previous slide -
'this eliminates all the stuff with deciding how many sentences there are etc, because we are
'simply replacing the previous slide's range with new text
If rSlide.Start > 0 Then 'check start >0 so we don't try to process anything before slide 1
'work where possible with a string variable rather than a document range. MUCH faster
sText = rSlide.Text
'cut the initial number line altogether by finding a colon and carriage return
iPos = InStr(sText, ":" & Chr(13))
sText = Mid(sText, iPos + 1) ' returns everything to the right of iPos+1
'remove unwanted double carriage returns
While InStr(sText, Chr(13) & Chr(13))
sText = Replace(sText, Chr(13) & Chr(13), Chr(13))
Wend
'cut any final CR
If Right(sText, 1) = Chr(13) Then sText = Left(sText, Len(sText) - 1)
'add marker code at each text line break - replacing need to count lines etc
sText = Replace(sText, Chr(13), Chr(11) & marker_code & " ")
'assemble full text, including the sText we have already built
sText = vSlide & " : " & staticTC & Chr(11) & static_next_line & Chr(11) & marker_code & " " & _
vSlide & " : " & sText & Chr(13) & Chr(13)
'replace the text in the pre-defined range rSlide. Much quicker than using the built-in Word find and replace
rSlide.Text = sText
End If
'set new start point for previous slide's range
rSlide.Start = rSlide.End + 1
'make vNext into vSlide
vSlide = vNext
Loop Until bStop
End SubHere is the progress bar code:
Option Explicit
Sub StatusBar()
Dim x As Integer
Dim MyTimer As Double
'Change this loop as needed.
For x = 1 To 250
'Dummy Loop here just to waste time.
'Replace this loop with your actual code.
MyTimer = Timer
Do
Loop While Timer - MyTimer < 0.03
Application.StatusBar = "Progress: " & x & " of 250: " & Format(x / 250, "Percent")
DoEvents
Next x
Application.StatusBar = False
End SubASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
The other thing that will speed up your code is to close all other word documents.
Just did that and I am current getting 18 seconds with the progress updater, and 10 seconds without it, on a 16-page document.
Just did that and I am current getting 18 seconds with the progress updater, and 10 seconds without it, on a 16-page document.
Ah. Interesting. The thing that speeds the code up more than ANYTHING, I discover, is eliminating the Word table in which you currently have the text. I converted the table to text and enlarged the file to 50 pages.
Then I I tweaked the code to handle both a table and ordinary word text. A 50 page document with no table now processes in 7.93 seconds on my laptop. This is probably because we're saving the time overhead from Word adjusting the table size, even with screen updates turned off.
Then I I tweaked the code to handle both a table and ordinary word text. A 50 page document with no table now processes in 7.93 seconds on my laptop. This is probably because we're saving the time overhead from Word adjusting the table size, even with screen updates turned off.
Sub RemoveParaOrLineBreaks()
'use constants here instead of variables
Const staticTC = "--:--:--:--,--:--:--:--,10"
Const static_next_line = "80 80 80"
'added this
Const marker_code = "C2N03"
Dim bStop As Boolean
'variant for previous and next slide number
Dim vSlide As Variant, vNext As Variant
'3 range variables:
Dim rSlide As Range, rNext As Range, rDoc As Range
'start and end long integer markers for rSlide range:
Dim iStart As Long, iEnd As Long
'length of slide number line, and current/previous page
Dim iPos As Long, iPage As Long, iPrev As Long
'variable to hold replacement text:
Dim sText As String
'timer variable
Dim uTime As Double
'start timer
uTime = Timer
'trap errors:
On Error GoTo errortrap
'turn off the screen
allOff
'initial setup
Set rDoc = ActiveDocument.Range
'create rSlide initially as zero size. NB do NOT set both rNext and rSlide to the whole document range, since
'this non-obviously makes them both the same range, and changing one will change the other
Set rSlide = ActiveDocument.Range(0, 0)
'set up the find parameters before you loop through the document, so you don't repeat unnecessary setup on each loop:
With rDoc.Find
.ClearFormatting
.Format = False
.Wrap = wdFindStop
.Forward = True
.MatchWildcards = False
End With
Do
'find the next slide
With rDoc.Find
.Execute FindText:="^p^#^#^#^#"
If .found Then
'set end of previous slide range
rSlide.End = rDoc.Start - 1
'set range of rnext
Set rNext = ActiveDocument.Range(rDoc.Start, rDoc.End)
rNext.End = rNext.End + 4
vNext = rNext.Text
'check the sixth character and include it if it's not a space, using VBA string function Mid
If Mid(vNext, 6, 1) <> Chr(32) Then
vNext = Mid(vNext, 2, 5)
Else
'otherwise just use the first four characters (omitting the carriage return at the start)
vNext = Mid(vNext, 2, 4)
End If
'if nothing found, then exit at end of loop
Else
bStop = True
'set final slide range.. assuming text is in a table, as in your example, this needs to be the end of the table cell
'if text is not in a table then use activedocument.range.end-1
If rSlide.Tables.Count = 0 Then
rSlide.End = ActiveDocument.Range.End - 1
Else
rSlide.End = rSlide.Cells(1).Range.End - 2
End If
End If
End With
'process the previous slide -
'this eliminates all the stuff with deciding how many sentences there are etc, because we are
'simply replacing the previous slide's range with new text
If rSlide.Start > 0 Then 'check start >0 so we don't try to process anything before slide 1
'work where possible with a string variable rather than a document range. MUCH faster
sText = rSlide.Text
'cut the number line
iPos = InStr(sText, ":" & Chr(13))
sText = Mid(sText, iPos + 1)
'remove unwanted carriage returns
While InStr(sText, Chr(13) & Chr(13))
sText = Replace(sText, Chr(13) & Chr(13), Chr(13))
Wend
'cut any final CR
If Right(sText, 1) = Chr(13) Then sText = Left(sText, Len(sText) - 1)
'add marker code at each text line break
sText = Replace(sText, Chr(13), Chr(11) & marker_code & " ")
'assemble full text, including existing sText
sText = vSlide & " : " & staticTC & Chr(11) & static_next_line & Chr(11) & marker_code & " " & _
vSlide & " : " & sText & Chr(13) & Chr(13)
'replace the text in the pre-defined range for the slide. Much quicker than using the built-in find and replace
rSlide.Text = sText
End If
'set new start point for previous slide's range
rSlide.Start = rSlide.End + 1
'make vNext into vSlide
vSlide = vNext
'get current page
iPage = rSlide.Information(wdActiveEndAdjustedPageNumber)
'update status bar if new page
If iPage > iPrev Then
Application.StatusBar = "Processing page " & iPage
'set new previous page
iPrev = iPage
'process "events" queue to force statusbar update
DoEvents
End If
Loop Until bStop
allOn
'exit routine if all ok
MsgBox "All pages processed in " & Format(Timer - uTime, "0.00") & " seconds."
Exit Sub
'handle error if not ok
errortrap:
allOn
MsgBox ("An error has occurred on page " & iPage)
End SubASKER
A few notes: unrelated to this question directly however allon and alloff tells me that it's calling a sub that doesn't exist. I'm using Word 2016 for Mac so perhaps the limitation is running it on a Mac. I know that the vba toolset isn't as full as on the windows side.
The progress bar works well however I suppose it's a bit confusing. I was thinking about putting the total number of pages in the document so it says page x of total however it appears that a 50 page document turns into about 90 when using this macro so at some point, the total number of pages would be inaccurate? Or would it dynamically update?
Also, would doing a simple copy and paste at the head of the program out of a table take care of the speed issue?
The progress bar works well however I suppose it's a bit confusing. I was thinking about putting the total number of pages in the document so it says page x of total however it appears that a 50 page document turns into about 90 when using this macro so at some point, the total number of pages would be inaccurate? Or would it dynamically update?
Also, would doing a simple copy and paste at the head of the program out of a table take care of the speed issue?
Did you put the code for allOn and AllOff in the module. They are not built-in routines... Should work fine on a Mac.
The page count updates as the document expands. Not sure what you mean by a simply copy and paste. There is a Word command in the table menu to "convert table to text". But if all the text is just in one table cell then yes, you could just copy and past it.
The page count updates as the document expands. Not sure what you mean by a simply copy and paste. There is a Word command in the table menu to "convert table to text". But if all the text is just in one table cell then yes, you could just copy and past it.
Sub allOff()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
End Sub
Sub allOn()
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.ScreenRefresh
End SubASKER
This has all, once again, been quite helpful. I'll play with the convert table to text command as there's no real reason it is in a table, just how it gets delivered. I'll keep this open for another day or two in case I have any questions.
ASKER
I added:
tpage = rSlide.Information(wdNumbe
and it increased the processing time by almost a minute. Is that a expected?
tpage = rSlide.Information(wdNumbe
and it increased the processing time by almost a minute. Is that a expected?
yes it is probably slow. I suspect Word initiates a page count when you request that information. Its handling of page numbers in general is quite clunky, since it is figuring out on the fly what page everything is on.
You'll often see an incorrrect page count at the bottom of a Word document which only updates when you move to a new page, or save the document. My guess would be that Word does not continuously track the page count, but recalculates it when asked.
It might be quicker to count all the slides first by running a "find" loop that simply counts instances of "^p^#^#^#^#" without doing any processing, and then have your updater reference "slide X of Y"
You'll often see an incorrrect page count at the bottom of a Word document which only updates when you move to a new page, or save the document. My guess would be that Word does not continuously track the page count, but recalculates it when asked.
It might be quicker to count all the slides first by running a "find" loop that simply counts instances of "^p^#^#^#^#" without doing any processing, and then have your updater reference "slide X of Y"
HOWEVER, there is a time penalty for doing this. In order to get the status bar to update in real time, you need to call the VBA "DoEvents" built-in function, which yields control of your PC to any pending system events.
So when I ran this just now on my 16 page dummy, it took 20 seconds as opposed to 7 without the status updater. How much time is wasted will depend on what else is going on on your PC. I'll see if there's a faster way to achieve the same thing, but there may not be.
Open in new window