Solved: Sub to set minimum font in Word stops responding in more complex doc

[Blakearino]

I have a sub that I kluged together from the internet. It is to set a minimumfont on a word document. I tested it on a basic Word document with different font sizes. It works as intended, however when I run it on a more complex and larger document it ceases to respond. I have to crash Word to halt it. I have determined that
ActiveDocument.Range.Characters.Count is roughly 24000 char for the problem document. Could this just be an ineffecient search on a large document or could something in the (Tables, Header/Footer, or something else) be causing the problem? Can I get the same result another way? Here is the code:

Private Sub CommandButton22_Click()
' sets minimum font size to ZZ
ZZ = TextBox15.Text
For i = 1 To ActiveDocument.Range.Characters.Count
If ActiveDocument.Range.Characters(i).Font.Size < ZZ Then
ActiveDocument.Range.Characters(i).Font.Size = ZZ
End If
Next
End Sub

Any assistance would be appreciated

Blake

[macropod]

If your document was properly designed, with Styles being used to set font attrinutes, all you'd need to do is make sure no Style has a point size greater than 22. Far faster - and a better use of document formatting - than overridding whatever Style definitions are in place.

[Blakearino]

Paul, thank you for the quick reply. These documents come from many different clients and have every possible corruption of styles (i.e. multiple pastes from all different types of sources, etc.). I do not have the time or knowledge to fix all the style problems.

[macropod]

You could use a macro like the following. As coded, it'll handle everything over 22pt, all the way up to Word's maximum - 1638pt. If you know what the maximum likely point size is, replace the '3276' with double that point size (eg if 72pt is that maximum, use 144) - there's no point in processing point sizes larger than you're likely to find.
Sub FixFonts()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Content.Find
.ClearFormatting
With .Replacement
.ClearFormatting
.Text = ""
.Font.Size = 22
End With
.Format = True
.Text = ""
.Wrap = wdFindContinue
For i = 43 To 3276
.Font.Size = i / 2
.Execute Replace:=wdReplaceAll
If i Mod 100 = 0 Then DoEvents
Next
End With
Application.ScreenUpdating = True
End Sub

[Blakearino]

Paul, Thanks again. I will give this a try. It will probably take much longer to understand it. The actual font size is the string ZZ (taken from TextBox15.Text, a textbox on a form). The default is currently 10 but I wanted the flexability to change it if needed. Forgot about screenupdating. In your macro, what does
With ActiveDocument.Content.Find
.ClearFormatting
do? Also this
For i = 43 To 3276
.Font.Size = i / 2
It looks like .font.size = 21.5 to 1638?
I had wanted any font less than 10 to be set to 10.
and finally
If i Mod 100 = 0 Then DoEvents
It looks like it triggers replacement in 100 step chunks.
I would modify my macro to this:

Private Sub CommandButton22_Click()
' sets minimum font size to ZZ
VV = TextBox15.Text
ZZ = VV*2 -1
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Content.Find
.ClearFormatting
With .Replacement
.ClearFormatting
.Text = ""
.Font.Size = VV
End With
.Format = True
.Text = ""
.Wrap = wdFindContinue
For i = ZZ To 144
.Font.Size = i / 2
.Execute Replace:=wdReplaceAll
If i Mod 100 = 0 Then DoEvents
Next
End With
Application.ScreenUpdating = True
End Sub

Would this change any font size less than ZZ to ZZ?

Blake
(edited for sloppy programming)

[macropod]

The macro I posted uses Word's Find/Replace tool to look for all fonts over the prescribed size (for which I shoulld have specified 45 rather than 43), then replaces them with the desired size (22).

.ClearFormatting blows away any Find/Replace formatting parameters that might have been left over from whatever else you might have been doing before the macro is run.

The DoEvents every 100 iterations is to give Word some breathing space for its own housekeeping. If you're only going up to 72pt max, you could change the 100 to a lower value (eg 25), which could help if there's a lot of text being changed.

To go the other way, to scale up to 10pt, basically you'd have:
For i = 2 to 19
With the code you posted, anything over VV will get reduced to VV. To increase it to the TextBox15.Text value, you'd need something like:
Private Sub CommandButton22_Click()
Application.ScreenUpdating = False
Dim i As Long
' sets minimum font size
With ActiveDocument.Content.Find
.ClearFormatting
With .Replacement
.ClearFormatting
.Text = ""
.Font.Size = TextBox15.Text
End With
.Format = True
.Text = ""
.Wrap = wdFindContinue
For i = 2 To TextBox15.Text * 2 - 1
.Font.Size = i / 2
.Execute Replace:=wdReplaceAll
If i Mod 100 = 0 Then DoEvents
Next
End With
Application.ScreenUpdating = True
End Sub
I do hope you have some data-entry validation on TextBox15!

[fumei]

"I do hope you have some data-entry validation on TextBox15!"

lol I hope so as well.

[Blakearino]

Paul and fumei, thanks for the information.
I do not have any validation as this is part of a userform that I created for my use; my garbage in , my garbage out ;) I have tried the original on my problem document with faster results and the macro does complete. I noticed that it did not seem to work for a style other than unformatted. This may be because I was assuming that it would set a minimum font size. I will try the new macro. Thank you for exposing me to the MOD function and using Word's search to scan the document. I had trouble figuring out which object to use to look at the font for each character.

Blake

[macropod]

A really basic validation test you could do for the sub's first two lines is:
If Not IsNumeric(TextBox15.Text) Then Exit Sub
If (TextBox15.Text < 1) Or (TextBox15.Text > 72) Then Exit Sub

[fumei]

At the very least.

Then anything non-numeric, or any number not within a valid range gets dumped. However, I am not sure you would want an Exit Sub. Would it not be more user-friendly to state the invalid parameter, and offer the user another try?

[macropod]

Yes, it would be more user-friendly, but I was only giving some 'last resort' trapping (which could stay in place even after someting better is developed). Friendliest of all would be a keypress validation on the entry textbox.

[Blakearino]

OK, OK. I put the validation test in the macro. It works sooo much better than what I had. Thank you both.

Blake