Find and replace font help....

[Tecnik]

Hi there,

I have a large Powerpoint presentation which I'm trying to do some global font changes to.

So far I've written this to try and find text with a certain font name, once I can find text that meets a certain .Name and .Size I'd like to change it.

When I try to execute the code below I get an error 'Object doesn't support this property or method' and it's happening with this line If aShape.TextFrame.TextRange.Font = "Haettenschweiler" Then'
Please can someone point me in the right direction.

Sub changeFont()
For Each aSlide In ActivePresentation.Slides
For Each aShape In aSlide.Shapes
If aShape.Type = msoTextBox Then
If aShape.TextFrame.HasText Then
If aShape.TextFrame.TextRange.Font = "Haettenschweiler" Then
MsgBox "Found one"
End If
End If
End If
Next
Next
End Sub


Thanks in advance.

Regards,

Nick

[John Wilson]

Nick

If aShape.TextFrame.TextRange.Font.Name = "Haettenschweiler" Then

[Tecnik]

Hi John,

Thanks for the help, it worked a treat.
I've tried taking the routine one step further to check the Size of the font but that seems to draw a blank even though I know there are instances of that font at that size.

Can I check the Size of the font or is that not a property under TextRange? I can't see it in the Object Browser.
I need to be able to check the size to narrow down the Find/Replace.

Here's my updated code:-

Sub changeFont()
For Each aSlide In ActivePresentation.Slides
For Each aShape In aSlide.Shapes
If aShape.Type = msoTextBox Then
If aShape.TextFrame.HasText Then

If aShape.TextFrame.TextRange.Font.Name = "Haettenschweiler" Then
If aShape.TextFrame.TextRange.Font.Size = 40 Then
'aShape.TextFrame.TextRange.Font.Name = "HelveticaNeue LT 97 BlackCn"

MsgBox "Found one"
End If
End If
End If

End If
Next
Next
End Sub

[John Wilson]

Font.Size should work.
Is the text definitely in a textbox?

For a more general search try this:
Sub changeFont()
Dim aSlide As Slide
Dim aShape As Shape
For Each aSlide In ActivePresentation.Slides
For Each aShape In aSlide.Shapes
If aShape.HasTextFrame Then
If aShape.TextFrame.HasText Then

If aShape.TextFrame.TextRange.Font.Name = "Haettenschweiler" Then
If aShape.TextFrame.TextRange.Font.Size = 40 Then


MsgBox "Found one"
End If
End If
End If

End If
Next
Next
End Sub

[Tecnik]

Hi John,

Thanks for your reply and for the code.

Your code works fine thanks.
I still get a problem when looking for a text size of 40 however after more investigation I think that is due to there been 2 text sizes in the one box?
Is there a way round that?

Thanks again for your time on this it's much appreciated.

Regards,

Nick

[John Wilson]

If your textrange has mixed sizes the code will fail unless the first match is true (ie the size 40 is the first character)

You could try looping through all characters in the range

If aShape.TextFrame.HasText Then
For i = 1 To Len(aShape.TextFrame.TextRange)
If aShape.TextFrame.TextRange.Characters(i).Font.Name = "Haettenschweiler" Then
If aShape.TextFrame.TextRange.Characters(i).Font.Size = 40 Then
MsgBox "Found one"
End If
End If
Next
End If

[Tecnik]

Hi John,

Thanks again for your help and for the code which does exactly what it says on the tin. Think I'll run it through it's paces to see how it goes. Fantastic!

Once again, thanks John.

Regards,

Nick