CafeTran

 Sometimes, I'm asked by my agency to create a double-line (bilingual) file: source above target.

I'd appreciate it if CT provides an option to automatically insert the source text in the target segment as a separate line above the translation (I will do this mostly after the translation work is over).

Peace,

Maybe it helps if you know what software this agency uses. Sounds a bit like Transit, but I am unsure.

How about converting a bilingual table to this?

Zou het voldoende zijn om een tweetalige tabel om te zetten in wat je zoekt?

Do you need formatting too?

Hebt ge ook opmaak nodig?

(Correct French? It's from Google Translate)

I know that the translated file needs a final finish in PowerPoint, because CT can't do duplicate formatting when it comes to font colors.

But it is helpful if CT can insert at least the source in plain text form above the target.

I just answered this. Now the answer is gone :(.

Another try, without explanation.

Use character formatting. Export as bilingual table. Add extra column. Replace ^t^p with ^p^p. Convert HTML tags to real formatting.

All this in a macro of course.

Sub Macro3()

'

' Macro3 Macro

'

'

Selection.SelectColumn

Selection.Delete Unit:=wdCharacter, Count:=1

Selection.Tables(1).Select

Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= _

True

Selection.MoveLeft Unit:=wdCharacter, Count:=1

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = "^t"

.Replacement.Text = "^p"

.Forward = True

.Wrap = wdFindContinue

.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 = "^p"

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = True

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

End Sub

I have to look up the conversion of HTML tags to formatting part, I have it on my disk. Too tired now.

You have to position the cursor in the first cell before you run the macro. I'm quite sure that this can be automated too. ;)

Speak to me, my child!

FormattingToMarkup

For Each aPar In ActiveDocument.Paragraphs

Set aRange = aPar.Range

If Len(aPar.Range.Text) > 2 Then

aRange.End = aRange.End - 1

aRange.Select

Selection.Cut

Selection.PasteAndFormat (wdFormatPlainText)

End If

Next aPar

 'Tags door opmaak vervangen

fkt_Search "<b>", "</b>", "Fett", False

fkt_Search "<i>", "</i>", "Kursiv", False

fkt_Search "<u>", "</u>", "Unterstrichen", False

End Sub

Sub FormattingToMarkup()

 '(c) René Probst

Dim oRange As Range, oRng As Range

Set oRange = ActiveDocument.Range

Application.ScreenUpdating = False

With oRange.Find

.Font.Bold = True

Flag = .Execute

While Flag = True

Set oRng = .Parent

If Asc(oRng.Characters.Last.Text) < 30 Then

 'falls Formatierung über das Zeilenende hinausgeht

oRng.SetRange oRng.Start, oRng.End - 1

End If

oRng.InsertBefore "<b>"

oRng.InsertAfter "</b>"

oRange.SetRange Start:=.Parent.End + 1, End:=ActiveDocument.Range.End + 1

Flag = .Execute

 Wend

End With

Set oRange = ActiveDocument.Range

With oRange.Find

.Font.Italic = True

Flag = .Execute

While Flag = True

Set oRng = .Parent

If Asc(oRng.Characters.Last.Text) < 30 Then

 'falls Formatierung über das Zeilenende hinausgeht

oRng.SetRange oRng.Start, oRng.End - 1

End If

oRng.InsertBefore "<i>"

oRng.InsertAfter "</i>"

oRange.SetRange Start:=.Parent.End + 1, End:=ActiveDocument.Range.End + 1

Flag = .Execute

 Wend

End With

Set oRange = ActiveDocument.Range

With oRange.Find

.Font.Underline = True

Flag = .Execute

While Flag = True

Set oRng = .Parent

If Asc(oRng.Characters.Last.Text) < 30 Then

 'falls Formatierung über das Zeilenende hinausgeht

oRng.SetRange oRng.Start, oRng.End - 1

End If

oRng.InsertBefore "<u>"

oRng.InsertAfter "</u>"

oRange.SetRange Start:=.Parent.End + 1, End:=ActiveDocument.Range.End + 1

Flag = .Execute

 Wend

End With

ActiveDocument.Range.Font.Reset

Application.ScreenUpdating = True

End Sub

Function fkt_Search(strStart As String, strEnd As String, strAktion As String, Optional bInclude As Boolean = False)

Dim rng As Range

Dim rng2A As Range, rng2E As Range

Dim rngText As Range

 ' Range festlegen

Set rng = ActiveDocument.Range

 ' Range festlegen

Set rngText = ActiveDocument.Range(0, 0)

rngText.Collapse wdCollapseStart

 ' Such-Schleife

With rng.Find

.Format = False

.Text = strStart

 ' Suche nach Start-Tag

.Execute

Do While .Found = True

 ' Fundstelle mit Start-Tag anlegen

rngText.SetRange rng.Start, rng.End

 ' Suchtextbereich reduzieren

rng.SetRange rng.End, ActiveDocument.Range.End

 ' Suche nach End-Tag

.Execute findtext:=strEnd, Forward:=True

 ' Abbruch wenn kein End-Tag

If .Found = False Then Exit Function

 ' Fundstelle bis End-Tag erweitern

rngText.SetRange rngText.Start, rng.End

rngText.Select

If bInclude = True Then

 ' mit Tags

 ' Beispiel: Kursiv, Fett, Unterstrichen...

Select Case strAktion

Case "Kursiv"

rngText.Font.Italic = True

Case "Fett"

rngText.Font.Bold = True

Case "Unterstrichen"

rngText.Font.Underline = wdUnderlineSingle

End Select

ElseIf bInclude = False Then

 ' ohne Tags, Tags löschen

 ' Beispiel: Kursiv, Fett, Unterstrichen...

Set rng2A = ActiveDocument.Range(0, 0)

Set rng2E = ActiveDocument.Range(0, 0)

rng2E.SetRange rngText.End - Len(strEnd), rngText.End

rng2E.Select

rngText.SetRange rngText.Start, rng.End

rng2A.SetRange rngText.Start, rngText.Start + Len(strStart)

rng2A.Select

rngText.SetRange rngText.Start + Len(strStart), rngText.End - Len(strEnd)

Select Case strAktion

Case "Kursiv"

rngText.Font.Italic = True

Case "Fett"

rngText.Font.Bold = True

Case "Unterstrichen"

rngText.Font.Underline = wdUnderlineSingle

End Select

rng2E.Delete 'Start-Tag löschen

rng2A.Delete ' End-Tag löschen

End If

 ' Suchtextbereich zur Endposition reduzieren

rng.Collapse wdCollapseEnd

 ' Start-Tag suchen

.Execute findtext:=strStart, Forward:=True

Loop

rng.Collapse wdCollapseEnd

End With

End Function

OMG, again ...

It's perfectly simple, but to automate it...

1. Save Project as HTML
2. Open HTML file in Word
3. Delete header and first column (numbers)
4. Convert table to text with paragraph marker