Draw Text Übersetzung

[koter]

Hallo norre,

Die Sysfilter-Demo lief bei mir nur halb. Erst hat der Vieren-Wächter Alarm gemacht (kann natürlich eine Falschmeldung gewesen sein) dann, nach Deaktivierung desselben, klappte das Rückschreiben von Sysfilter nach Corel nicht. Das liegt vielleicht an X4.

Beim Suchen und Ersetzen mit Excel ist mir aufgefallen, dass man danach die Übersetzungstabelle nicht mehr ändern kann, weil der Text in Corel ersetzt wurde und somit nicht mehr gefunden wird. Bei automatischer Übersetzung wird man aber wohl nicht um einige Änderungen herumkommen.

Falls Du noch über eine Excel-Lösung nachdenkst, kannst Du Dir mal folgenden Ansatz ansehen.

Dabei werden die einzelnen Texte über die StaticID identifiziert. Dadurch sind auch nachträgliche Änderungen an der Übersetzungstabelle möglich. Das Makro ist natürlich noch sehr experimentell, es bearbeitet auch nur Grafiktext, das kann man aber umstricken.

Code:

Sub NachExcel()
    Dim ap As Page, p As Page
    Dim s As Shape
    Set ap = ActivePage
    Set xl = GetObject(, "Excel.Application")
    For i = 1 To 4
        xl.Cells(1, i).Font.Bold = True
    Next i
    i = 1
    xl.Cells(i, 1).Value = "Seite"
    xl.Cells(i, 2).Value = "StaticID"
    xl.Cells(i, 3).Value = "Text"
    xl.Cells(i, 4).Value = "Übersetzung"
    For Each p In ActiveDocument.Pages
        For Each s In p.Shapes
            If s.Type = cdrTextShape Then
                If s.Text.Type = cdrArtisticText Then
                    i = i + 1
                    xl.Cells(i, 1).Value = p.Index
                    xl.Cells(i, 2).Value = s.StaticID
                    xl.Cells(i, 3).Value = s.Text.Story.Text
                    xl.Cells(i, 4).Value = s.Text.Story.Text
                End If
            End If
        Next
    Next
    xl.Columns("A:D").EntireColumn.AutoFit
    Set xl = Nothing
End Sub

Sub VonExcel()
    Dim ap As Page, p As Page
    Dim s As Shape
    Set ap = ActivePage
    Set xl = GetObject(, "Excel.Application")
    ActiveDocument.BeginCommandGroup "Text Ersetzen"
    i = 2
    Do
        Seite = xl.Cells(i, 1).Value
        StatID = xl.Cells(i, 2).Value
        Übersetzung = xl.Cells(i, 4).Value
        If Seite = "" Then
            Exit Do
        Else
            Set s = ActiveDocument.Pages(Seite).FindShape(StaticID:=StatID)
            s.Text.Story.Text = Übersetzung
        End If
        i = i + 1
    Loop
    ActiveDocument.EndCommandGroup
    Set xl = Nothing
End Sub

Gruß

Koter