Selecting Character Object in Word Document using VBA

[bodmin]

Hi guys,

I am trying to use a piece of code to search through a document to locate where a particular font, size and formatting is used and then put the user focus on this character in the document.

I currently have the following code but on my call to goto the object I keep getting a bad parameter error, cant seem to work out why either as the object I am requesting to goto appears to have a value when looking at it in the debug screen.

Thanks in advance for any assisstance.

Sub Locate_Font()
'
' Locate_Font Macro
' Macro created 22/06/2007 by Andrew Smith
'
Dim strFontToFind As String
Dim strFontSizeToFind As String
Dim strFontBoldIndicator As String
Dim FontBoldIndicator As Boolean
Dim myDoc As Object
Dim myRange As Object
Dim ThisCharacter As Object

Set myDoc = ActiveDocument
Set myRange = ActiveDocument.Range()

CharacterCount = myRange.Characters.Count
Set ThisCharacter = myRange.Characters(18)

MsgBox ("Character Count = " & CharacterCount)
MsgBox ("18th Character = " & ThisCharacter)

strFontToFind = InputBox("Please type the name of the font that you are looking for.", "Font To Find")
strFontSizeToFind = InputBox("Please type the size of the font that you are looking for.", "Font Size To Find")
strFontBoldIndicator = InputBox("Please indicate whether the font you are looking for is Bold Formatted.", "Font Formatting to Find")

If strFontBoldIndicator = "True" Then
'Or "Yes" Or "true" Or "yes" Or "y" Or "Y" Then
FontBoldIndicator = True
End If

If strFontBoldIndicator = "False" Then
' Or "No" Or "false" Or "no" Or "n" Or "N" Then
FontBoldIndicator = False
End If

LoopCount = 1
Do While LoopCount < CharacterCount
Set ThisCharacter = myRange.Characters(LoopCount)
ThisFontName = myRange.Characters(LoopCount).Font.Name
ThisFontSize = myRange.Characters(LoopCount).Font.Size
ThisFontBold = myRange.Characters(LoopCount).Font.Bold
ThisFontItalic = myRange.Characters(LoopCount).Font.Italic
If ThisFontName = strFontToFind And ThisFontSize = strFontSizeToFind And ThisFontBold = FontBoldIndicator Then
'Do While ThisFontName = strFontToFind And ThisFontSize = strFontSizeToFind And ThisFontBold = FontBoldIndicator
FoundCount = LoopCount
myDoc.GoTo What:=wdGoToObject, Which:="ThisCharacter"
'Loop
MsgBox ("Count " & CharacterCount)
MsgBox ("This Font Name = " & ThisFontName)
End If


LoopCount = LoopCount + 1
Loop
End Sub

 

[TonyJollans]

Hi bodmin,

You can't GoTo a Character - but you could Select it with:
[blue][tt] ThisCharacter.Select[/tt][/blue]

However, you can use Find to perform this operation rather than writing your own code to loop through, which could be poorly performing compared to the built-in option.

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

Professional Office Developers Association

 

[bodmin]

Hi Tony,

Many thanks for your reply. I had been trying to use the find function as another way of achieving this but couldnt get it to successfully highlight the characters required.

What I wanted was for the code to loop through the document and whereever it finds a certain character to highlight this in a different colour.

I could get the find function to successfully loop through but could not get this to highlight the text in the document. Any ideas how I could code this?

Many thanks in advance
Andi

 

[TonyJollans]

Hi Andi,

Instead of your loop ...

[blue]    Selection.Find.ClearFormatting
    Selection.Find.Font.Name = strFontToFind
    Selection.Find.Font.Size = strFontSizeToFind
    Selection.Find.Font.Bold = FontBoldIndicator
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
[/blue]

As an aside and for future reference, questions about VBA are better asked in the the VBA Forum

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

Professional Office Developers Association