Macro to make text/field codes superscripted in header/footers.

[Renée]

Hello,

I want to create a macro that will search the whole document including
headers and footers for specified text and then replace with superscripted
text. the field codes used are {SUBJECT \*MERGEFORMAT} and {TITLE
\*MERGEFORMAT}

I found this reference but am not sure how to incorporate the superscript
part.

http://word.mvps.org/FAQs/Customization/ReplaceAnywhere.htm

Does anyone have any advice. I've only used recorded macros and this is my
first foray into the macro world. So any advice/guidance is appreciated.
Thanks.

Renée

 

[Doug Robbins - Word MVP]

Hi Renée,

The following will do what you want:

Dim afield As Field
Dim rngStory As Word.Range
Dim lngJunk As Long
With ActiveDocument
'Fix the skipped blank Header/Footer problem as provided by Peter Hewett
lngJunk = .Sections(1).Headers(1).Range.StoryType
'Iterate through all story types in the current document
For Each rngStory In .StoryRanges
'Iterate through all linked stories
Do
For Each afield In rngStory.Fields
If afield.Type = wdFieldTitle Or wdFieldSubject Then
afield.Code.Font.Superscript = True
afield.Update
End If
Next afield
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Graham Mayor]

This is not quite as simple a task, as you want to reformat fields that have
a mergeformat switch, which will conspire against you. To format all the
Subject and Title fields in your document you need a slightly different
approach. The following will change the mergeformat switch for the two field
types to a charformat switch, then apply superscript to the first characters
of the fields which in conjunction with the charformat switch will display
the whole fields as superscript. http://www.gmayor.com/installing_macro.htm

Public Sub ChangeField()
Dim rngStory As Word.Range
Dim oRng As Range
Dim iFld As Integer
Dim lngJunk As Long

lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For Each rngStory In ActiveDocument.StoryRanges
Do
Selection.HomeKey
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
For iFld = rngStory.Fields.Count To 1 Step -1
With rngStory.Fields(iFld)
If .Type = wdFieldTitle Or .Type = wdFieldSubject Then
If InStr(1, .Code, "MERGEFORMAT") <> 0 Then
.Code.Text = replace(.Code.Text, "MERGEFORMAT",
"CHARFORMAT")
End If
If InStr(1, .Code, "CHARFORMAT") = 0 Then
.Code.Text = .Code.Text & " \* CHARFORMAT "
End If
.Code.Select
Set oRng = Selection.Range
With oRng
.start = oRng.Characters(1).start
.End = oRng.Characters(2).End
.Font.Superscript = True
End With
.Update
End If
End With
Next iFld
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
With ActiveWindow.View
.Type = wdPrintView
.SeekView = wdSeekMainDocument
.ShowFieldCodes = False
.Type = wdPrintView
End With
End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Renée]

Hello again,

The header text did become superscripted so the macro worked in that sense
-- big thanks.But I want to replace for example, instance of CP with a
superscripted CP (treat it like a trademark) in the header. Where do I insert
the find and replace all code? Is it safe to assume that I would replace
starting at "With0Rng" and "End With". Would this code work as a replacement?

With Selection.Find
.Text = "CP"
.Replacement.Text = "CP"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
With Selection
With .Font
.Superscript = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End With


Any help or guidance is greatly appreciated. If you know of any good
resources; I'd like to understand the code better.
Thanks

Renée

 

[Graham Mayor]

Something like

Public Sub ReplaceAnywhere()
Dim rngStory As Word.Range
Dim lngJunk As Long
With ActiveDocument
lngJunk = .Sections(1).Headers(1).Range.StoryType
For Each rngStory In .StoryRanges
Do
With rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "<CP>"
.Replacement.Font.Superscript = True
.Replacement.Text = "^&"
.MatchWildcards = True
.Execute replace:=wdReplaceAll
End With
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
End With
End Sub


should do the trick


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>