Excel exectuing Word VBA; Issue with Find & Replace

[mehunter]

I am having an issue executing Find & Replace VBA code from MSExcel operating on instance of MSWord.



The following code instances demonstrate the difference when identical VBA code is executing in MSExcel and the same code is executed in MSWord.



In the code, 6 lines of "Normal" style Text are created. Three of the lines are marked with "!# ", to provide tags to convert to "List Paragraph" style.



The following code is executed from MSWord and works correctly:










Sub TestCodeOperatingInWord()

Dim wdDoc As Object



Application.ScreenUpdating = False



Set wdApp = CreateObject("Word.Application")

Set wdDoc = Documents.Add 'Open new Word document


wdDoc.Activate

Visible = True

Dim rng As Object

Set rng = Application.ActiveDocument.Range(Start:=0, End:=0)

Selection.EndKey wdStory, wdMove

Selection.TypeText Text:="New text Line 1"

Selection.InsertParagraph

Selection.EndKey wdStory, wdMove

Selection.TypeText Text:="New text Line 2"

Selection.InsertParagraph

Selection.EndKey wdStory, wdMove

Selection.TypeText Text:="New text Line 3"

Selection.InsertParagraph

Selection.EndKey wdStory, wdMove

Selection.TypeText Text:="!# A. New Indented Text Line 1"

Selection.InsertParagraph

Selection.EndKey wdStory, wdMove

Selection.TypeText Text:="!# B. New Indented Text Line 2"

Selection.InsertParagraph

Selection.EndKey wdStory, wdMove

Selection.TypeText Text:="!# C. New Indented Text Line 3"

Selection.InsertParagraph

With ActiveDocument.Content.Find

.ClearFormatting

.Style = ActiveDocument.Styles("Normal")

With .Replacement

.ClearFormatting

.Style = ActiveDocument.Styles("List Paragraph")

End With

.Execute FindText:="!# ", ReplaceWith:="", _

Format:=True, Replace:=wdReplaceAll

End With



ActiveDocument.Range.Select

With Selection.Find

.Text = "!# "

.Replacement.Text = ""

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Selection.Find.Execute Replace:=wdReplaceAll



End Sub







The following code executed from MSExcel does not perform Find and Replace:








Sub TestCodeOperatingOnWordInstanceInExcel()

Dim wdDoc As Object



Set wdApp = CreateObject("Word.Application")

Set wdDoc = wdApp.Documents.Add 'Open new Word document



wdDoc.Activate

wdApp.Visible = True

Dim rng As Object

Set rng = wdApp.Application.ActiveDocument.Range(Start:=0, End:=0)

wdApp.Selection.EndKey wdStory, wdMove

wdApp.Selection.TypeText Text:="New text Line 1"

wdApp.Selection.InsertParagraph

wdApp.Selection.EndKey wdStory, wdMove

wdApp.Selection.TypeText Text:="New text Line 2"

wdApp.Selection.InsertParagraph

wdApp.Selection.EndKey wdStory, wdMove

wdApp.Selection.TypeText Text:="New text Line 3"

wdApp.Selection.InsertParagraph

wdApp.Selection.EndKey wdStory, wdMove

wdApp.Selection.TypeText Text:="!# A. New Indented Text Line 1"

wdApp.Selection.InsertParagraph

wdApp.Selection.EndKey wdStory, wdMove

wdApp.Selection.TypeText Text:="!# B. New Indented Text Line 2"

wdApp.Selection.InsertParagraph

wdApp.Selection.EndKey wdStory, wdMove

wdApp.Selection.TypeText Text:="!# C. New Indented Text Line 3"

wdApp.Selection.InsertParagraph



wdApp.ActiveDocument.Range.Select

With wdApp.ActiveDocument.Content.Find

.ClearFormatting

.Style = wdApp.ActiveDocument.styles("Normal")

With .Replacement

.ClearFormatting

.Style = wdApp.ActiveDocument.styles("List Paragraph")

End With

.Execute FindText:="!# ", ReplaceWith:="", _

Format:=True, Replace:=wdReplaceAll

End With



wdApp.ActiveDocument.Range.Select

With wdApp.Selection.Find

.Text = "!# "

.Replacement.Text = ""

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

wdApp.Selection.Find.Execute Replace:=wdReplaceAll

End Sub







Please note that MSWord definitions, e.g. wdFindContinue, may need to be converted to their elaborations:






Public Const wdFindContinue As Long = 1





Help greatly appreciated; this one has me stumped.

[mana]

Option Explicit


Sub test()
Dim wdApp As Object
Dim wdDoc As Object
Dim rng As Object
Dim s As String

Application.ScreenUpdating = False

Set wdApp = CreateObject("Word.Application")
Set wdDoc = wdApp.Documents.Add 'Open new Word document
wdApp.Visible = True



s = vbCr & "New text Line 1"
s = s & vbCr & "New text Line 2"
s = s & vbCr & "New text Line 3"
s = s & vbCr & "!# A. New Indented Text Line 1"
s = s & vbCr & "!# B. New Indented Text Line 2"
s = s & vbCr & "!# C. New Indented Text Line 3"

Set rng = wdDoc.Range

rng.Text = s

With rng.Find
.ClearFormatting
.Style = wdDoc.Styles("Normal")
.MatchWildcards = True

With .Replacement
.ClearFormatting
.Style = wdDoc.Styles("List Paragraph")
End With

.Execute FindText:="\!# (*)", ReplaceWith:="\1", _
Format:=True, Replace:=2 'wdReplaceAll

End With

End Sub

[paulked]

It seemed to work for me. The document looked like this:

New text Line 1
New text Line 2
New text Line 3
____A. New Indented Text Line 1
____B. New Indented Text Line 2
____C. New Indented Text Line 3

(without the lines!)

[mehunter]

Interesting, I'm not familiar with the FindText/ReplaceWith formats you used, but it works. Some additional work on my part to prevent subsequent uses from continuing previous lettering, and to set the outline level for subsequent indentures (A. B. C. 1. 2. D. ...).

This one has had me stumped for a week, much indebted to you and the forum for quick reply.
M

[mehunter]

Supposing that I prepended "!# " for OutlineLevel1 of the "List Paragraph" style that I create, and "!## " for OutlineLevel2 of the "List Paragraph" styles I create. Could OutlineLevel be added to the Find/Replace above?

The example above defaults to OutlineLevel = 1

Producing a listing like this:

New Text Line 1
New Text Line 2
New Text Line 3
A. New Indented Text Line 1
B. New Indented Text Line 2
1. New Indented Text Line 1 at OutlineLevel 2

[mana]

Option Explicit

Sub test2()
Dim wdApp As Object
Dim wdDoc As Object
Dim rng As Object
Dim s As String

Application.ScreenUpdating = False

Set wdApp = CreateObject("Word.Application")
Set wdDoc = wdApp.Documents.Add 'Open new Word document
wdApp.Visible = True

s = vbCr & "New text Line 1"
s = s & vbCr & "New text Line 2"
s = s & vbCr & "New text Line 3"
s = s & vbCr & "!# A. New Indented Text Line 1"
s = s & vbCr & "!## B. New Indented Text Line 2"
s = s & vbCr & "!# C. New Indented Text Line 3"

Set rng = wdDoc.Range

rng.Text = s

With rng.Find
.MatchWildcards = True

.Replacement.ParagraphFormat.IndentCharWidth 1

.Execute FindText:="\!# (*)", ReplaceWith:="\1", _
Format:=True, Replace:=2 'wdReplaceAll

.Replacement.ParagraphFormat.IndentCharWidth 2

.Execute FindText:="\!## (*)", ReplaceWith:="\1", _
Format:=True, Replace:=2 'wdReplaceAll

End With

End Sub

[mehunter]

Once again, thanks!

Simple and elegant.
meh