stop selection when finding certain font

[Tony Logan]

I have a document where there's an unknown amount of text that is font x (x
being Arial, or Times, or whatever). This text will sometimes include
paragraph marks.

I want to select all the text that is font x and stop selecting as soon as I
get to a font that isn't x.

I thought the below code would do the trick, but instead I'm getting caught
in an endless loop. Any ideas? Thanks.

code (assumes the cursor is at the first character of font x):

With Selection
.ExtendMode = True
Do Until Selection.Font.Name <> "Arial"
.MoveRight Unit:=wdCharacter
Loop
End With

 

[Anne Troy]

Hi, Tony. This crappy recorded macro goes until it find the first character
in Arial font, then it backs up one character.

Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^?"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
End Sub

I'm no coder, but I know Word.

*******************
~Anne Troy

www.OfficeArticles.com
www.MyExpertsOnline.com

 

[Dan]

This will work decently enough:
Public Sub DiffFont()
Dim rngStart As Range
Dim strStartFont As String
Selection.Collapse wdCollapseStart
Selection.MoveRight unit:=wdCharacter, Count:=1, Extend:=True
Set rngStart = Selection.Range
strStartFont = Selection.Font.Name
Do
Selection.MoveRight unit:=wdCharacter, Count:=1
If Selection.End = ActiveDocument.Content.End - 1 Then rngStart.End =
Selection.End + 1: Exit Do
If Selection.Font.Name <> strStartFont Then rngStart.End =
Selection.Range.End - 1: Exit Do
Loop
rngStart.Select
Set rngStart = Nothing
End Sub

 

[Jay Freedman]

Hi Dan,

Yes, it will work "decently enough", but if the document is large and
the first font change occurs a few thousand characters after the start
of the Selection, it's going to be a long wait while it checks each
character.

This macro is faster because it uses a technique called "binary
search", meaning that each iteration of the loop cuts the remaining
region in half and then determines which half to look at next. It also
relies on an oddity of VBA, that the property oRg.Font.Name returns an
empty string if the range contains more than one font.

Sub DiffFont2()
Dim oRg As Range
Dim nStart As Long, nEnd As Long
Dim nDiff As Long, nSame As Long

nStart = Selection.Start
nEnd = ActiveDocument.Range.End
Set oRg = ActiveDocument.Range(nStart, nEnd)

nSame = nStart
nDiff = nEnd

Do While (nSame < nDiff - 1)
nEnd = Int((nSame + nDiff) / 2)
Set oRg = ActiveDocument.Range(nStart, nEnd)
If (oRg.Font.Name = "") Then
nDiff = nEnd
Else
nSame = nEnd
End If
Loop

If (oRg.Font.Name = "") Then
oRg.End = oRg.End - 1
End If

oRg.Select
Set oRg = Nothing
End Sub

 

[John]

Jay, are there any other odities like this when checking for things
other than the font name, eg when checking for the character or
paragraph style?

 

[Jay Freedman]

Hi John,

Yes, there are some others, but styles need to be handled a slightly
different way.

If a range includes two different paragraph styles, and you ask for "the
style of the range", you get back a value of Nothing. Try this little macro
to see what I mean:

Sub foo()
Dim oRg As Range
Dim oSty As Style
Set oRg = Selection.Range
Set oSty = oRg.Style
If oSty Is Nothing Then
Debug.Print "Range has more than one para style"
Else
Debug.Print oSty.NameLocal
End If
End Sub

If the range contains only one paragraph style, but two or more character
styles (one of which may be the default format of the underlying paragraph
style), then VBA sees only the paragraph style. If the entire range contains
only one paragraph style and one non-default character style, then you'll
get the character style's name. The bottom line is that you can't use this
method to check for multiple character styles -- you just don't get back
enough information.

Attributes that normally return numerical values -- for example, .Font.Size
or .ParagraphFormat.LeftIndent -- will return wdUndefined (which is a
built-in constant equal to 9999999) if the range contains multiple values:

Sub foo()
If Selection.Font.Size = wdUndefined Then
Debug.Print "Range has more than one size"
Else
Debug.Print Selection.Font.Size
End If
End Sub