From Ms Word table to TMX file | Apostrophe and straight double quote

Forum: CAT Tools Technical Help
Topic: From Ms Word table to TMX file
Poster: Hans Lenting
Post title: Apostrophe and straight double quote

Added correct encoding of apostrophes and straight double quotes.

Will add handling of bold, italics, underlined, superscript and subscript soon. See here if you want to go ahead.

BTW: For a complete list of Microsoft's locale IDs see:
[url removed]

Sub TableToTMX()

Dim rngTemp As Range
Dim tableTemp As Table
Dim strSL As String
Dim strTL As String

'Determine the source and target language
Selection.Tables(1).Columns(1).Select
strSL = Selection.LanguageID
Selection.Tables(1).Columns(2).Select
strTL = Selection.LanguageID

Select Case strSL
Case 1031
strSL = "de-DE"
Case 1033
strSL = "en-US"
Case 1043
strSL = "nl-NL"
Case Else
strSL = InputBox("Type the code for the source language", "Source language selection", "en-GB")
End Select

Select Case strTL
Case 1031
strTL = "de-DE"
Case 1033
strTL = "en-US"
Case 1043
strTL = "nl-NL"
Case Else
strTL = InputBox("Type the code for the target language", "Target language selection", "nl-NL")
End Select

Options.AutoFormatReplaceQuotes = False
Selection.Tables(1).Select
Selection.Copy
Documents.Add
Selection.Paste

Set tableTemp = ActiveDocument.Tables(1)
Set rngTemp = _
tableTemp.ConvertToText(Separator:=wdSeparateByTabs)
Selection.Delete

'Convert ampersand, less than and greater than to markup
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "&"
.Replacement.Text = "&"
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "«"
.Replacement.Text = ""
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'Handle apostrophe and straight double quote
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "'"
.Replacement.Text = "'"
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = """"
.Replacement.Text = """
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p"
.Replacement.Text = _
"«/seg»«/tuv»«/tu»^p«tu»«tuv xml:lang=""xx-XX""»«seg»"
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^t"
.Replacement.Text = "«/seg»«/tuv»«tuv xml:lang=""yy-YY""»«seg»"
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.TypeText Text:="«/seg»«/tuv»«/tu»«/body»«/tmx»"
Selection.HomeKey Unit:=wdStory
Selection.TypeText Text:="«?xml version=""1.0"" encoding=""utf-8""?»«tmx version=""1.4""»«header»«/header»«body»«tu»«tuv xml:lang=""xx-XX""»«seg»"

'Replace placeholder language codes with correct codes
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "xx-XX"
.Replacement.Text = strSL
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "yy-YY"
.Replacement.Text = strTL
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

'Adjust path below
ActiveDocument.SaveAs2 FileName:="/Users/hl/Desktop/memory.tmx", FileFormat:= _
wdFormatText, Encoding:=65001, LineEnding:=wdLFOnly
End Sub

[Edited at 2022-09-11 07:05 GMT]