Draw Text Übersetzung

[norre]

Hallo Koter,
dein neues Sub funktioniert ganz wunderbar.
Rausschreiben und wieder einlesen, alles bestens und wenn nichts geändert wird bleibt der Text erhalten - Klasse

Allerdings habe ich jetzt dass Problem, dass bei den Bestellnummer oft doch einzelne Worte übersetzt werden müßten.
Ich habe dir mal einen Screenshot von einem Artikel angehängt, da wäre es dann das Material z.B Messing vernickelt aber es gibt dann auch andere Bemerkungen.
Und wenn ich den Übersetzter komplett die Bestellnummer usw.nochmal eingeben lasse, mh, so wie ich das mitbekommen habe sind die dort auch nicht die Wordprofis ;-).
Deshalb meine Idee wenn der Text schon drinstehen würde, aber vielleicht hättest du ja noch eine Idee ob und wie das zu lösen wäre.

Ansonsten ist dein Macro schon jetzt wieder eine ganz große Hilfe

Nochmal vielen herzlichen Dank dafür

[koter]

Hallo Norre,

Den Originaltext auch in die zu übersetzenden Abschnitte zu setzen ist kein Problem.

Im Screenshot sieht es so aus, als wenn dort Tabulatoren verwendet werden. Wenn der Übersetzer die zerschießt gibt es viel Nacharbeit für Dich.

Für das Problem fällt mir auf Anhieb nichts ein.

Um den Originaltext auch in die zu übersetzenden Abschnitte zu setzen musst Du in der SUB zuWord einen Befehl hinzufügen. Er ist im folgenden Code-Auschnitt mit: 'Originaltext in Übersetzungsfeld gekennzeichnet.

Code:

With wd.Selection
                    .TypeText t
                    .Sections(1).Range.Bookmarks.Add "SID" & sid
                    .TypeParagraph
                    .InsertBreak Type:=3
                    .TypeText t 'Originaltext in Übersetzungsfeld
                    .InsertBreak Type:=3
                End With

Gruß

Koter

[norre]

Hallo Koter,
ich bin begeistert, werde es morgen nochmal ausgiebig testen, aber so wie das aussieht funktioniert alles, auch die Tabulatoren werden beim Zurückschreiben richtig gesetzt.

Ich melde mich dann auf jeden Fall bei dir.

Nach einen schönen Abend

[norre]

Hallo Dr. Macro,
so Text ist beim übersetzen, mal schauen was der daraus macht ;-)

[SIZE="7]Du[/SIZE] [SIZE="6]u[/SIZE][SIZE="5]u[/SIZE][SIZE="4]u[/SIZE][SIZE="3]u[/SIZE][SIZE="2]u[/SIZE][SIZE="1]uu[/SIZE], wenn dir mal ganz langweilig ist, gäbe es eine Möglichkeit das so zu machen, dass das Macro nur auf bearbeitbare oder druckbare Ebenen zugreift? Also nicht bearbeitbare oder nicht druckbare Ebenen ignoriert.

[koter]

Oh weh Norre!

Ich hatte diesen Beitrag übersehen!

Welches denn? zuWord, vonWord oder alle beide?

Gruß

Koter

[norre]

Oh weh Norre!
Ich hatte diesen Beitrag übersehen!
Welches denn? zuWord, vonWord oder alle beide?
r

Hallo Koter,
eilt überhaupt nicht, ich bin ja eh schon ganz happy mit deinem Macro :bounce:

eigentlich zuWord.

Ich habe da z.B Bemaßungen in den Bildern die bräuchten ja nicht übersetzt werden und das habe ich momentan eh auf einer eigenen Ebene.
Ich habe jetzt einfach alles was nicht in die Übersetzung sollte gruppiert, geht natürlich auch, eleganter wäre es natürlich wenn ich einfach die Ebene unbearbeitbar mache und dein Macro diese dann ignorieren würde.

[koter]

Ist ja eigendlich egal welches.

Die Änderungen sind nur geringfügig.

zuWord:

Code:

For Each p In ActiveDocument.Pages
        For Each s In p.Shapes
            If s.Type = cdrTextShape And s.Layer.Printable And s.Layer.Editable Then 'neu
                t = s.Text.Story.Text
                sid = s.StaticID
                With wd.Selection
                    .TypeText t
                    .Sections(1).Range.Bookmarks.Add "SID" & sid
                    .TypeParagraph
                    .InsertBreak Type:=3
                    .TypeText t 'Originaltext in Übersetzungsfeld
                    .InsertBreak Type:=3
                End With
            End If
        Next
    Next

vonWord:

Code:

For Each p In ActiveDocument.Pages
                Set s = p.FindShape(StaticID:=sid)
                If s Is Nothing Then
                Else
                    t2 = NDers(t)
                    If Len(t2) > 0 And s.Layer.Printable And s.Layer.Editable Then 'neu
                        s.Text.Story.Text = t
                    End If
                End If
            Next

...die mit 'Neu gekennzeichneten Zeilen austauschen

ich hoffe, das war noch rechtzeitig

Gruß

Koter

[norre]

ich hoffe, das war noch rechtzeitig

Dicke.........
der gute Mann ist gerade dabei den ersten Katalog zu übersetzen sind ja gut 160 Seiten.
Und bei den anderen Katalogen sind se gerade auf die glorreiche Idee gekommen zu überprüfen was da noch aktuell ist, was rausfliegen kann und vor allem was an neuen Sachen noch rein muss............ und das kann.... aus Erfahrung....dauern ;-)

Auf jeden Fall nochmal herzlichen Dank für deine Hilfe