B
Bob
Beginner vba user - completely stuck and could do with some assistance please regarding using replacement text which holds its format.
I have simple code that selects find [variable] 1st column table and selects replacement text from 2nd column. The replacement text is formatted sometimes within the cell and has tables (nested in the cell) and inline graphic or addresses with returns or paragraphs with returns (^p).
The active document is on screen and the find/replace inserts the replacement text but does not insert nested tables (these become just text with faint square blocks), nor paragraph marks these also turn into faint square blocks and the table of course does not insert.
How do I enable my code to allow the text or nested table or inline graphic or address with pilcrow returns insert as the replacement text and hold format?
Any ideas how I can achieve this please that would allow my replacement text to be richtext
desperate newbie...
Sub ReplaceListv3()
Dim vFindText As Variant
Dim vReplText As Variant
Dim sFindText As Range
Dim sReplText As Range
Dim i As Long
Dim SourceFile As String
Dim Source As Document
Dim Target As Document
Set Target = ActiveDocument 'The document in which the replacements are to be made
Dim Msg, Style, Title, Response
Msg = "Do you want to use the default replacements file ?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Select Source File" ' Define title.
' Display message.
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' User chose Yes.
Set Source = Documents.Open("c:\documents\basic.doc") 'Open the document containing the table of
'replacements to be made. It assumes that there is a header row in the table.
'Modify the path and filename to suit.
Else ' User chose No. Display the FileOpen dialog
With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
SourceFile = ""
MsgBox "You did not select a file."
Exit Sub
Else
SourceFile = WordBasic.FileNameInfo$(.Name, 1)
End If
Set Source = Documents.Open(SourceFile) 'Open the selected document
End With
End If
With Source.Tables(1)
For i = 2 To .Rows.Count
Set sFindText = .Cell(i, 1).Range
sFindText.End = sFindText.End – 1
Set sReplText = .Cell(i, 3).Range
sReplText.End = sReplText.End - 1
Target.Activate
‘Target.content.select ‘reinforce grab right document
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = False
.Text = sFindText
‘Text=”^p”
.Replacement.Text = sReplText
.Execute Replace:=wdReplaceAll
End With
Next i
End With
Source.Close wdDoNotSaveChanges
Target.Activate
;Target.content.select ‘reinforce grab right document
End Sub
I have simple code that selects find [variable] 1st column table and selects replacement text from 2nd column. The replacement text is formatted sometimes within the cell and has tables (nested in the cell) and inline graphic or addresses with returns or paragraphs with returns (^p).
The active document is on screen and the find/replace inserts the replacement text but does not insert nested tables (these become just text with faint square blocks), nor paragraph marks these also turn into faint square blocks and the table of course does not insert.
How do I enable my code to allow the text or nested table or inline graphic or address with pilcrow returns insert as the replacement text and hold format?
Any ideas how I can achieve this please that would allow my replacement text to be richtext
desperate newbie...
Sub ReplaceListv3()
Dim vFindText As Variant
Dim vReplText As Variant
Dim sFindText As Range
Dim sReplText As Range
Dim i As Long
Dim SourceFile As String
Dim Source As Document
Dim Target As Document
Set Target = ActiveDocument 'The document in which the replacements are to be made
Dim Msg, Style, Title, Response
Msg = "Do you want to use the default replacements file ?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Select Source File" ' Define title.
' Display message.
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' User chose Yes.
Set Source = Documents.Open("c:\documents\basic.doc") 'Open the document containing the table of
'replacements to be made. It assumes that there is a header row in the table.
'Modify the path and filename to suit.
Else ' User chose No. Display the FileOpen dialog
With Dialogs(wdDialogFileOpen)
If .Display <> -1 Then
SourceFile = ""
MsgBox "You did not select a file."
Exit Sub
Else
SourceFile = WordBasic.FileNameInfo$(.Name, 1)
End If
Set Source = Documents.Open(SourceFile) 'Open the selected document
End With
End If
With Source.Tables(1)
For i = 2 To .Rows.Count
Set sFindText = .Cell(i, 1).Range
sFindText.End = sFindText.End – 1
Set sReplText = .Cell(i, 3).Range
sReplText.End = sReplText.End - 1
Target.Activate
‘Target.content.select ‘reinforce grab right document
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = False
.Text = sFindText
‘Text=”^p”
.Replacement.Text = sReplText
.Execute Replace:=wdReplaceAll
End With
Next i
End With
Source.Close wdDoNotSaveChanges
Target.Activate
;Target.content.select ‘reinforce grab right document
End Sub