W
wzrokowiec
Hello
Two years ago Mr Graham Mayor helped me a lot with writing a macro in Microsof
Visual Basic 6.3 that I've been using till now but I need a small modification
The macro works as follows
it searches through a tekst in an open Word document, finds a string o
characters that is given in a table in a separate file and changes string
foun
in one column to those in the second column
Now I need a small improvement: it should mark with red font color the whol
paragraphs it DOES NOT change. That's all. I'm quoting the macro and need som
help with adding this function
Sub correction(
Dim oChanges As Document, oDoc As Documen
Dim oTable As Tabl
Dim oRng As Rang
Dim rFindText As Range, rReplacement As Rang
Dim i As Lon
Dim sFname As Strin
'************************************
sFname = "C:corrections.doc
'************************************
Set oDoc = ActiveDocumen
Set oChanges = Documents.Open(FileName:=sFname, Visible:=False
Set oTable = oChanges.Tables(1
For i = 1 To oTable.Rows.Coun
Set oRng = oDoc.Rang
Set rFindText = oTable.Cell(i, 1).Rang
rFindText.End = rFindText.End -
Set rReplacement = oTable.Cell(i, 2).Rang
rReplacement.End = rReplacement.End -
With oRng.Fin
.ClearFormattin
.Replacement.ClearFormattin
Do While .Execute(findText:=rFindText,
MatchWholeWord:=True,
MatchWildcards:=False,
Forward:=True,
Wrap:=wdFindContinue) = Tru
oRng.Text = rReplacemen
Loo
End Wit
Next
oChanges.Close wdDoNotSaveChange
End Su
Thank yo
wZrokowiec
Two years ago Mr Graham Mayor helped me a lot with writing a macro in Microsof
Visual Basic 6.3 that I've been using till now but I need a small modification
The macro works as follows
it searches through a tekst in an open Word document, finds a string o
characters that is given in a table in a separate file and changes string
foun
in one column to those in the second column
Now I need a small improvement: it should mark with red font color the whol
paragraphs it DOES NOT change. That's all. I'm quoting the macro and need som
help with adding this function
Sub correction(
Dim oChanges As Document, oDoc As Documen
Dim oTable As Tabl
Dim oRng As Rang
Dim rFindText As Range, rReplacement As Rang
Dim i As Lon
Dim sFname As Strin
'************************************
sFname = "C:corrections.doc
'************************************
Set oDoc = ActiveDocumen
Set oChanges = Documents.Open(FileName:=sFname, Visible:=False
Set oTable = oChanges.Tables(1
For i = 1 To oTable.Rows.Coun
Set oRng = oDoc.Rang
Set rFindText = oTable.Cell(i, 1).Rang
rFindText.End = rFindText.End -
Set rReplacement = oTable.Cell(i, 2).Rang
rReplacement.End = rReplacement.End -
With oRng.Fin
.ClearFormattin
.Replacement.ClearFormattin
Do While .Execute(findText:=rFindText,
MatchWholeWord:=True,
MatchWildcards:=False,
Forward:=True,
Wrap:=wdFindContinue) = Tru
oRng.Text = rReplacemen
Loo
End Wit
Next
oChanges.Close wdDoNotSaveChange
End Su
Thank yo
wZrokowiec