Macro Text verschieben

[norre]

Hallo,
ich wollte mir gerade ein Macro aufnehmen, dass allen Text (Mengen und Grafiktext) auswählt und auf die Ebene Text verschiebt.
Allerdings nimmt Corel den Befehl unter Bearbeiten-->Alles Auswählen-->Text, nicht richtig auf und wählt noch einige Bilder dazu.
Hat von euch jemand eine Idee wie der Code da lauten könnte?

[Unkraut]

Hallo Norre,
hab es nur an zwei einfachen Seiten getestet, aber bei mir funzte es so, (selbst das Makro! :lol es wurde kein Bild (*.jpg) mit ausgewählt. Hast Du irgend eine Verknüpfung zu dem Bild?

Wenn es nur eine einfache Seite ist, werde ich gern Deine *.cdr testen. Ist der Unterschied in 64-Bit und 32-Bit-Version begründet?

Liebe Grüße vom Kraut

[norre]

Hallo, nein keine Verknüpfung, wenn ich das über Bearbeiten mache funktioniert das auch und es wird nur Text ausgewählt, nur wenn ich es beim Macro mit aufzeichne kappts nicht. Mal nimmt es ein Bitmap mit, dann lässt es wieder zwei Textrahmen stehen, immmer verschieden, komisch

Könntest du vielleicht deinen Code zum vergleichen hier posten?

[Unkraut]

Kann es am Font liegen?
(Die "textebene" hatte ich vor der Ausführung des Makros erstellt.)

Code:

Sub Macro2()
    ' Recorded 21.10.2013
    ActiveDocument.CreateShapeRangeFromArray(ActiveLayer.Shapes(5), ActiveLayer.Shapes(4), ActiveLayer.Shapes(3), ActiveLayer.Shapes(2), ActiveLayer.Shapes(1)).Cut
    Dim pasteopt As StructPasteOptions
    Set pasteopt = CreateStructPasteOptions
    With pasteopt.ColorConversionOptions
        .SourceColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 (ECI),Gray Gamma 2.2"
        .TargetColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 (ECI),Gray Gamma 2.2"
    End With
    Dim Paste1 As ShapeRange
    Set Paste1 = ActivePage.Layers("textebene").PasteEx(pasteopt)
End Sub

die letzten Gartentomaten (vom Markt) des Jahres warten auf Kräuter und daaaaas Kraut

[norre]

die letzten Gartentomaten (vom Markt) des Jahres warten auf Kräuter und daaaaas Kraut

Danke dir, mal schaun obs funktioniert, bei mir schaut das anderst aus .

Bei mir hängen doch noch ne ganze Menge Tomaten an den Pflanzen, mal schaun wenns jetzt so warm bleibt werden die sicher noch rot werden :-)

[koter]

Hallo norre,

Hat von euch jemand eine Idee wie der Code da lauten könnte?

Unter X4 geht das mit diesem Code:

Code:

Sub TextAufAktEbene()
    Dim s As Shape
    ActiveDocument.BeginCommandGroup "Text auf aktive Ebene"
    For Each s In ActivePage.Shapes
        If s.Type = cdrTextShape Then
            s.Layer = ActiveLayer
        End If
        'Gruppe
        If s.Type = cdrGroupShape Then
            Call TextInGrpAufAktEbene(s)
        End If
        'Gruppe Ende
    Next
    ActiveDocument.EndCommandGroup
End Sub

Sub TextInGrpAufAktEbene(gs As Shape)
    Dim s As Shape
    For Each s In gs.Shapes
        If s.Type = cdrTextShape Then
            Call RausAusGruppe(s)
            s.Layer = ActiveLayer
        End If
        If s.Type = cdrGroupShape Then
            Call TextInGrpAufAktEbene(s)
        End If
    Next
End Sub

Sub RausAusGruppe(s As Shape)
    Dim PG As Shape
    Set PG = s.ParentGroup
    If PG Is Nothing Then
        Exit Sub
    Else
        s.OrderFrontOf PG
        Call RausAusGruppe(s)
        If PG.Shapes.Count < 2 Then
            PG.Ungroup
        End If
    End If
End Sub

Das Makro verschiebt den Text einer Seite auf die aktive Ebene, egal wie diese benannt ist.
Es wird auch der Text aus Gruppen auf die aktive Ebene verschoben.
Wenn Du das nicht willst, musst Du den Code zwischen 'Gruppe und 'Gruppe Ende löschen oder auskommentieren.
Die Subs TextInGrpAufAktEbene und RausAusGruppe sind dann auch überflüssig.

Text, der an Objekten ausgerichtet ist, wird nicht verschoben.

Gruß

Koter

[norre]

Hallo Koter,
das funktioniert wieder perfekt und dass auch in Gruppen verschoben wird ist genau dass was ich brauche -



@Unkraut auch dir dankeschön,