How to replace Classification markings with Auto Text field

[jcupak]

I need to replace all the "(U)", "(C)", and "(S)" markings at the
beginning of every paragraph with the corresponding Auto Text. For
example (without the quotes, of course), "{ QUOTE (U) {SEQ U \r {PAGE}
\h }}" I would like to create the Auto Text in the macro, but can
define it beforehand and run the macro to replace it. I've seen the
opposite replacement method, but not one to replace text with Auto
Text. Any help would be greatly appreciated.

 

[Doug Robbins - Word MVP]

Use the Selection.InsertAutotext command after selecting the text that
represents the name of the autotext item that you want to replace it 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, originally posted via msnews.microsoft.com

 

[jcupak]

Use the Selection.InsertAutotext command after selecting the text that
represents the name of the autotext item that you want to replace it with..

--
Hope this helps.

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

I recorded and edited a "find and replace" macro to come up with the
following code:

Sub Replace_U()
'
' Replace (U) with Unclassified AutoText
' Macro written 5/11/2009 by John Cupak
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "(U)"
.Replacement.Text = "(U) " <-- This SHOULD be the autotext
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
NormalTemplate.AutoTextEntries("Unclassified").Insert
Where:=Selection.Range, RichText:=True
End Sub

Unfortunately, it requires me to search for each classification
marking manually, as the macro works by finding, deleting, then
inserting the autotext.

I know that I could insert the autotext directly:

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
PreserveFormatting:=False
Selection.TypeText Text:="QUOTE (S) "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
PreserveFormatting:=False
Selection.TypeText Text:="SEQ S \r"
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
PreserveFormatting:=False
Selection.TypeText Text:="PAGE"
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.TypeText Text:="\h"

But this seems like a lot of work.

Isn't there an easier way to find and replace ALL the classification
markings? (Of course, "(U)" is only 1 of 3 markings).

 

[Pesach Shelnitz]

I'm not sure why you need to create AutoText entries to do what I think you
want to do. It seems to me to be an unnecessary complication. The following
macro replaces "(U) ", "(C) ", and "(S) " by the specified field codes. Let
us (the newsgroup) know if you still need to create the AutoText entries.

Sub ReplaceClassificationMarks()
Dim myField As Field

Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
Do While .Execute(Findtext:="(U) ", _
MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Selection.Delete
Set myField = ActiveDocument.Fields.Add(Range:=Selection.Range, _
Type:=wdFieldEmpty)
myField.Code.Text = "QUOTE (U)"
Loop
End With
Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
Do While .Execute(Findtext:="(C) ", _
MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Selection.Delete
Set myField = ActiveDocument.Fields.Add(Range:=Selection.Range, _
Type:=wdFieldEmpty)
myField.Code.Text = "SEC U \r"
Loop
End With
Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
Do While .Execute(Findtext:="(S) ", _
MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Selection.Delete
Set myField = ActiveDocument.Fields.Add(Range:=Selection.Range, _
Type:=wdFieldEmpty)
myField.Code.Text = "PAGE \h"
Loop
End With
Set myField = Nothing
End Sub

 

[jcupak]

I'm not sure why you need to create AutoText entries to do what I think you
want to do. It seems to me to be an unnecessary complication. The following
macro replaces "(U) ", "(C) ", and "(S) " by the specified field codes. Let
us (the newsgroup) know if you still need to create the AutoText entries.

Sub ReplaceClassificationMarks()
    Dim myField As Field

    Selection.HomeKey wdStory
    With Selection.Find
        .ClearFormatting
        Do While .Execute(Findtext:="(U) ", _
            MatchWildcards:=False, _
            Wrap:=wdFindStop, Forward:=True) = True
            Selection.Delete
            Set myField = ActiveDocument.Fields.Add(Range:=Selection.Range, _
                Type:=wdFieldEmpty)
            myField.Code.Text = "QUOTE (U)"
         Loop
    End With
    Selection.HomeKey wdStory
    With Selection.Find
        .ClearFormatting
        Do While .Execute(Findtext:="(C) ", _
            MatchWildcards:=False, _
            Wrap:=wdFindStop, Forward:=True) = True
            Selection.Delete
            Set myField = ActiveDocument.Fields.Add(Range:=Selection.Range, _
                Type:=wdFieldEmpty)
            myField.Code.Text = "SEC U \r"
         Loop
    End With
    Selection.HomeKey wdStory
    With Selection.Find
        .ClearFormatting
        Do While .Execute(Findtext:="(S) ", _
            MatchWildcards:=False, _
            Wrap:=wdFindStop, Forward:=True) = True
            Selection.Delete
            Set myField = ActiveDocument.Fields.Add(Range:=Selection.Range, _
                Type:=wdFieldEmpty)
            myField.Code.Text = "PAGE \h"
         Loop
    End With
    Set myField = Nothing
End Sub

If I define an AutoText field named "Unclassified" as "{ QUOTE (U)
{SEQ U \r{PAGE} \h}}" (where the "{}" are defined as the field code
delimiters, NOT the curly braces), then I want to search for and
replace every "(U)" in the text with the corresponding Unclassified
AutoText. This effectively inserts the "(U)" text, but also inserts
the hidden sequence number field.

The use of AutoText with hidden sequence numbers is based on the
"Conditional Headers and Footers" article (http://gregmaxey.mvps.org/
Conditional_Headers_Footers.htm) by Greg Maxey.

So, what I'm looking to create is a macro that will let me take an
existing Word document and replace all the "(U)" text classifications
with the corresponding AutoText. I also need to do the same for the
other "(C)" and "(S)" classification text with their corresponding
AutoText.

Hope this clarifies the problem a little better.

John

 

[Pesach Shelnitz]

Thanks for the clarification about the need for the AutoText entries. I read
Greg Maxey's extremely interesting article, and now I think that I understand
what you are trying to accomplish. Here is a revised version of my macro,
which incorporates some of your code for creating the field codes.

Sub ReplaceClassificationMarks()
Dim myField As Field

Set myField = ActiveDocument.Fields.Add(Range:=Selection.Range, _
Type:=wdFieldEmpty, PreserveFormatting:=False)
myField.Code.Text = "QUOTE (U) "
myField.Select
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="SEQ U \r"
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="PAGE"
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.TypeText Text:="\h"
myField.Select
NormalTemplate.AutoTextEntries.Add Name:="U", Range:=Selection.Range
Selection.Delete

Set myField = ActiveDocument.Fields.Add(Range:=Selection.Range, _
Type:=wdFieldEmpty, PreserveFormatting:=False)
myField.Code.Text = "QUOTE (C) "
myField.Select
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="SEQ C \r"
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="PAGE"
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.TypeText Text:="\h"
myField.Select
NormalTemplate.AutoTextEntries.Add Name:="C", Range:=Selection.Range
Selection.Delete

Set myField = ActiveDocument.Fields.Add(Range:=Selection.Range, _
Type:=wdFieldEmpty, PreserveFormatting:=False)
myField.Code.Text = "QUOTE (S) "
myField.Select
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="SEQ S \r"
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="PAGE"
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.TypeText Text:="\h"
myField.Select
NormalTemplate.AutoTextEntries.Add Name:="S", Range:=Selection.Range
Selection.Delete

Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
Do While .Execute(Findtext:="(U) ", _
MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Selection.Delete
NormalTemplate.AutoTextEntries("U").Insert
Where:=Selection.Range, _
RichText:=True
Loop
End With
Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
Do While .Execute(Findtext:="(C) ", _
MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Selection.Delete
NormalTemplate.AutoTextEntries("C").Insert
Where:=Selection.Range, _
RichText:=True
Loop
End With
Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
Do While .Execute(Findtext:="(S) ", _
MatchWildcards:=False, _
Wrap:=wdFindStop, Forward:=True) = True
Selection.Delete
NormalTemplate.AutoTextEntries("S").Insert
Where:=Selection.Range, _
RichText:=True
Loop
End With
ActiveDocument.Fields.Update
Set myField = Nothing
End Sub