Mengentextrahmen-Verknüpfungen kopieren

[koter]

Hallo Sabine,
willkommen im Forum!

Du könntest auch ein Makro verwenden:



Das ist nur ein Beispiel. Die Animation ist gekürzt. Die Nummerierung (3600 Marken auf 4 Seiten) hat bei mir über eine Minute gedauert.

Bevor Das Makro ausgeführt wird muss eine Nummer als Grafiktext in die erste Marke gesetzt werden.
das Makro verwendet die Nummer als erste Zahl und zählt von da aus hoch.
Marke und Grafiktext müssen vor dem Start ausgewählt werden.

Das Makro:

Code:

Sub Nummerieren()
   Dim Seite As Page
   Dim srNo As New ShapeRange, srMarken As New ShapeRange, srMarkenSeite As New ShapeRange
   Dim srMuster As ShapeRange
   Dim s As Shape, sMNummer As Shape, sObj As Shape
   Dim sNummer As New Shape
   Dim Nummer As Integer, z As Integer
   Set srMuster = ActiveSelectionRange
   For Each s In srMuster
       If s.Type = cdrTextShape Then
           Set sMNummer = s
           srNo.Add sMNummer
       Else
           Set sObj = s
           srNo.Add sObj
       End If
   Next
   For Each Seite In ActiveDocument.Pages
       Set srMarkenSeite = Seite.FindShapes
       srMarkenSeite.Sort " @shape1.Top * 100 - @shape1.Left > @shape2.Top * 100 - @shape2.Left"
       srMarken.AddRange srMarkenSeite
   Next
   srMarken.RemoveRange srNo
   Nummer = Val(sMNummer.Text.Story)
   ActiveDocument.BeginCommandGroup "Nummerieren"
   Application.Optimization = True
   For Each s In srMarken
       Nummer = Nummer + 1
       Set sNummer = sMNummer.CopyToLayer(s.Layer)
       With sNummer
           .Text.Story = Nummer
           .CenterX = s.CenterX
           .CenterY = s.CenterY
       End With
   Next
   Application.Optimization = False
   ActiveDocument.EndCommandGroup
   Application.Refresh
   Refresh
End Sub

Ein ähnliches Thema hatten wir schon einmal. Vielleicht ist das für Dich interessant.

Gruß

Koter