Font Change in Word Macro

L

Lynda

I tried the information already listed bu kept getting debut errors -- I am
self taught sorry.

I need to force documents to merge but keep getting stray Times Roman font
intermittently and want to include line in my merge macro, to find any
isntances of TRmn and force it to change over to Arial. ( The Normal.dot is
in Arial)

If someone could help me with acrtual macro string for this please?


Thanks..
 
O

old man

Hi,

When merging documents lots of info comes in and you should note that the
last character in a section (or document) contains lots of information (e.g.
header, footer, formatting...) that you may not want to migrate into the
target document.

Here is some code from MSDN KB article: http://support.microsoft.com/kb/209251
that happens to do exactly (including the fonts) what you want:

Sub ReplaceFont()
With Selection.Find
' Clear all previously set formatting for Find dialog box.
.ClearFormatting
' Set font to Find for replacement.
.Font.Name = "Times New Roman"
' Clear all previously set formatting for Replace dialog box.
.Replacement.ClearFormatting
' Set font to Replace found font.
.Replacement.Font.Name = "Arial"
' Don't find or replace any text.
.Text = ""
.Replacement.Text = ""
' The following parameters must be set as follows
' to find only text formatted for the specified font.
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
' Perform the find and replace.
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

old man
 
L

Lynda

apologies for response delay but away until now. Many thanks for the
assistance below -- it's worked perfectly. :))
 
L

Lynda

Hmmm -- getting an error at the last stage sorry..... This is what the
entire piece of code looks liek -- can you teel me which piece is the culprit
and how it should appear? I am getting message that 'compile error expecyed
End With'

(Once the downloaded document is in Word, I run the macro and it shuffles
everything around into the rquired format, searching, replacing etc. Have I
added the replace font piece in at the wrong point perhaps and that's why
incorrect?)

Grateful for any assistance again.

Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.TypeText Text:="l"
Selection.Range.InsertAutoText
Selection.TypeBackspace
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " Services"
.Replacement.Text = " Days ** Refer above **"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "per Service for "
.Replacement.Text = "per Day for "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "OTHER INCLUSIONS^p^p"
.Replacement.Text = "OTHER INCLUSIONS^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "INSURANCE DETAILS^p^p"
.Replacement.Text = "INSURANCE DETAILS^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "ACCOMMODATION DETAILS^p^p"
.Replacement.Text = "ACCOMMODATION DETAILS^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "FLIGHT DETAILS^p^p"
.Replacement.Text = "FLIGHT DETAILS^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "OTHER DETAILS^p^p"
.Replacement.Text = "OTHER DETAILS^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveWindow.ActivePane.SmallScroll Down:=56
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "OTHER DETAILS^p^p"
.Replacement.Text = "OTHER DETAILS^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Date of Departure"
.Replacement.Text = "OTHER DETAILS^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=2, Extend:=wdExtend
Selection.Copy
Selection.Cut
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.TypeText Text:="m"
Selection.Range.InsertAutoText
Selection.TypeBackspace
Selection.Find.ClearFormatting
With Selection.Find
.Text = "We are pleased to confirm"
.Replacement.Text = "OTHER DETAILS^p"
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeText Text:="i"
Selection.Range.InsertAutoText
Selection.TypeParagraph
Selection.Find.ClearFormatting
With Selection.Find
.Text = "CONFIRMATION"
.Replacement.Text = "OTHER DETAILS^p"
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Font.Size = 12
Selection.Font.Bold = wdToggle
Selection.Font.Name = "Arial"
Selection.TypeText Text:="TRAVEL "
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.TypeBackspace
Selection.TypeBackspace
Selection.TypeBackspace
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Paste
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=2
Selection.MoveRight Unit:=wdWord, Count:=3
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.ColorIndex = wdRed
With Selection.Find
.Text = "** Refer above **"
.Replacement.Text = "** Refer above **"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.ClearFormatting
.Font.Name = "Times New Roman"
.Replacement.ClearFormatting
.Replacement.Font.Name = "Arial"
.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
End Sub
 
O

old man

Hi Lynda,

The next to the last "with" statement is unpaired:

it should have anend with'

Your code:
With Selection.Find
.Text = "CONFIRMATION"
.Replacement.Text = "OTHER DETAILS^p"
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.MoveLeft Unit:=wdCharacter, Count:=1

should be:
With Selection.Find
.Text = "CONFIRMATION"
.Replacement.Text = "OTHER DETAILS^p"
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
end with
Selection.MoveLeft Unit:=wdCharacter, Count:=1

When you have a little time replace the searches with a subroutine - it
would be a lot easier to maintain.

The code looks like you recorded all the code - not that there is anything
wrong with that but after recording you should edit the code.

Live by the macro recorder - die by the macro recorder.

old man
 
L

Lynda

thanks so much for your patience and assistance. :)) Yes, all recorded and
then I try and work out what each section relates to so I can learn more.Not
that good with sub routines so all my macros suffer from bloat...

I should have stayed at school longer and paid more attention! :))

Thanks again :))
 
O

old man

Hi Lynda,

Its good to take classes but the best way to learn is by doing -which is
what you are engaged in. Try reading a good VBA book for 1/2 hour a day.
Don't memorize just try to understand the concepts.

take care,
old man
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Word Font Issues - Not Seeing Fonts in Microsoft Fonts Folder 6
Replying to emails changes font 1
Why did font change? 12
Word 2007 - Spacing and Kerning (changing from 1 font to another) 4
Macro to change Userform Textbox Font attributes 3
how do I stop Outlook changing the font in my email signature? 1
Outlook using Word ---> What's up with the FONTS????? 1
Outlook changes font to Times when changing e-mail format to HTML 0

Top