Makro erzeugt Laufzeitfehler

[koter]

Hallo Norbert,

...Kann ich die Funktion auf mehrseitige Dokumente erweitern?...

Ja, das geht so:

Code:

Sub DiesUndDasJedeSeite()
   Dim Seite As Page
   Dim MitUmriss As ShapeRange
   ActiveDocument.Unit = cdrMillimeter
   For Each Seite In ActiveDocument.Pages
       Seite.Activate
       ActiveDocument.BeginCommandGroup "DiesUndDas Seite" & Seite.Index
       Set MitUmriss = Seite.Shapes.FindShapes(, , True, "@com.Outline.Width > 0")
       MitUmriss.Shapes.All.SetOutlinePropertiesEx ScaleWithShape:=cdrTrue
       With Seite.Shapes.All
           .ConvertToCurves
           .Group
           .Stretch 0.1
           .CenterX = ActivePage.CenterX
           .CenterY = ActivePage.CenterY
       End With
       Seite.SetSize 210, 297
       ActiveDocument.EndCommandGroup
       ActiveWindow.ActiveView.ToFitPage
   Next
End Sub

Gruß

Koter