Find-Replace text contained in textboxes and tables

[JD21]

Hello everyone,

I'm hoping I can get come help from a programmer.
What I want to do is to automatically translate a word report generated by a software, so I turned to macros. I already have a word file containing the original word/phrases and the translated ones.
I 'stole' the code to translate from some forum online, which works great with normal text, attached.
My problem is that the text of the report I want to translate is within various "text boxes" and "tables" (this is automatically generated by another software).
I assumed that if I removed the textboxes and tables without removing the text they contain, I would simply end up with just text and then run the attached macro. I was able to manually remove the tables, but keep the text. This totally ruined the formatting, but I can deal with that latter. Now, unfortunately I cannot do the same with textboxes. There is no 'delete, but keep the text" function for textboxes, so I'm stuck.
Is it possible to modify the attached code, so that it can "scan" the words contained withing various textboxes and tables of the same word file?
I really appreciate your time.
JD
14568

[gmayor]

If you are going to take that approach using ranges, then oRng is the main document body. You can however process all the story ranges e.g.


Option Explicit

Sub Translate()

Dim oChanges As Document, oDoc As Document
Dim oTable As Table
Dim rFindText As Range, rReplacement As Range
Dim oStory As Range
Dim i As Long
Dim sFname As String
'Change the path in the line below to reflect the Emri and path of the table document
sFname = "C:\Users\user\Desktop\Dictionary.doc"
Set oDoc = ActiveDocument
Set oChanges = Documents.Open(Filename:=sFname, Visible:=False)
Set oTable = oChanges.Tables(1)

For Each oStory In oDoc.StoryRanges
For i = 1 To oTable.Rows.Count
Set rFindText = oTable.Cell(i, 1).Range
rFindText.End = rFindText.End - 1
Set rReplacement = oTable.Cell(i, 2).Range
rReplacement.End = rReplacement.End - 1
With oStory.Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(findText:=rFindText, _
MatchWholeWord:=True, _
MatchWildcards:=False, _
Forward:=True, _
Wrap:=wdFindContinue) = True
oStory.Text = rReplacement
Loop
End With
Next i
If oStory.StoryType <> wdMainTextStory Then
While Not (oStory.NextStoryRange Is Nothing)
Set oStory = oStory.NextStoryRange
For i = 1 To oTable.Rows.Count
Set rFindText = oTable.Cell(i, 1).Range
rFindText.End = rFindText.End - 1
Set rReplacement = oTable.Cell(i, 2).Range
rReplacement.End = rReplacement.End - 1
With oStory.Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(findText:=rFindText, _
MatchWholeWord:=True, _
MatchWildcards:=False, _
Forward:=True, _
Wrap:=wdFindContinue) = True
oStory.Text = rReplacement
Loop
End With
Next i
Wend
End If
Next oStory
Set oStory = Nothing
oChanges.Close wdDoNotSaveChanges
End Sub

[JD21]

Dear gmayor,
It worked perfectly :bow:
You just made my day :)
Thank you very very much
JD

[JD21]

Dear gmayor,

I need some more help please. Something strange is happening, at least strange to me :D.

As I mentioned, I tested your macro and it worked great. I tried it on a few reports, generated by the same software but, it worked with a few and didn't work with my latest ones. It only replaced the first couple of words and then the wheel kept running until I forced word to terminate.

I noticed that the difference between these reports is that in the last ones, I have added the info and logo of my company in the general settings of the software, which of course is reflected in the new report.
So, to make sure that this was in fact causing the issue, I removed the info from the software, generated a 'fresh' report and ran the macro again. Sure enough, it worked!
The added info is text and a logo in image, so I assumed that deleted the logo image within the table, would resolve the problem, deleted it, but still it didn't work.

Any ideas?

Thanks a lot

[gmayor]

Can you post a sample of the document?

[JD21]

Hello,
Attached please find samples of the working and not working documents
On another note, could the background picture on the first page cause this?

1459214593

thx

[gmayor]

The following macro reports the content of each story range. It seems to cover all the not working document. If the text you are trying to replace is in the message boxes then you should be able to change it.


Sub Check()
Dim oStory As Range
For Each oStory In ActiveDocument.StoryRanges
MsgBox oStory.Text
If oStory.StoryType <> wdMainTextStory Then
While Not (oStory.NextStoryRange Is Nothing)
Set oStory = oStory.NextStoryRange
MsgBox oStory.Text
Wend
End If
Next oStory
Set oStory = Nothing
End Sub

[JD21]

it returns the same range for both documents, yet in one of them it changes it, in the other it doesn't. :banghead: