Makro für Konturerstellung

[koter]

Hallo Regina,

...das die nötigen Schritte so weit als möglich beinhaltet...

Ich habe versucht die nötigen Schritte so weit als möglich zu erraten    :

Code:

Sub PKontur1()
   Dim SR1 As ShapeRange, SR2 As ShapeRange
   Dim s1 As Shape
   Dim Abstand As Double, Linienstil As Double, Liniebreite As Double
   
   If ActiveSelectionRange.Shapes.Count = 0 Then Exit Sub
   
   ActiveDocument.BeginCommandGroup "Konturlinie"
   ActiveDocument.Unit = cdrMillimeter
   
   Abstand = 4
   Liniebreite = 0.3
   
   Set SR1 = ActiveSelectionRange
   Set s1 = SR1.CustomCommand("Boundary", "CreateBoundary")
   Set SR2 = s1.CreateContour(, Abstand).Separate
   
   SR2.OrderBackOf SR1.FirstShape
   With SR2.FirstShape
       .Name = "Konturlinie"
       .Outline.Width = Liniebreite
   End With
   s1.Delete
   
   ActiveDocument.EndCommandGroup
End Sub

Ich hoffe es läuft mit Deiner Version.
Abstand und Linienbreite kannst Du im Quelltext ändern.
Falls noch etwas fehlt melde Dich, ich bin leider nicht der beste Ratefuchs.

Gruß

Koter