Macro Text verschieben

[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