Makro-Nachhilfe für Funktionen für alle Objekte

[asterix]

Hallo Koter,

herzlichen Dank. Das mit der Zwischenablage funktioniert einwandfrei - zwei kleine Wörtchen, aber darauf muss man ja erstmal kommen.

Bezüglich meines Kenntnisstandes: Du kannst ihm 1:1 in diesem Thema folgen . Ich weiß nichts über VBA, was über mein hier Geschriebenes hinausgeht.

Und das führt auch genau zu dem hier aufgetretenen Phänomen: Ich habe einfach dazugelernt. Dadurch haben sich manche Fragen erledigt, manche neue Fragen kamen dazu. Aber es steht weiterhin alles unter dem gemeinsamen Thema, dem es folgt: Wie man manche Makro-Funktionen, die man hier und anderswo für einen bestimmten Anwendungsfall findet, eben allgemein für alle Objekte eines Dokuments nutzen kann.

Das hat auch alle perfekt geklappt, alle Fragen konnten geklärt werden.
Alle?
Nicht ganz .


Leider weiß ich nur eine Sache immer noch nicht. Wie kann ich in dem unten folgenden Gesamt-Code die Zeile

Code:

For Each sl In ActiveSelection.Shapes: sl.Curve.Nodes.All.Smoothen 20
Next

so korrigieren, dass sie für alle Objekte (Umrisse, Füllungen) funktioniert?

Ich kann aus deinen beiden bisherigen Antworten aufgrund meines mangelnden Wissens leider keinen Code ableiten.

Code:

Sub opencopy()
    ' Recorded 30.06.2024
    Dim lr1 As Layer
    Set lr1 = ActiveDocument.Pages(1).CreateLayer("Ebene 1")
    ' Recording of this command is not supported
    Dim impopt As StructImportOptions
    Set impopt = CreateStructImportOptions
    impopt.MaintainLayers = True
    Dim impflt As ImportFilter
    Set impflt = lr1.ImportEx("C:\objekt.ai", 1283, impopt)
    impflt.Finish
    Dim s1 As Shape
    Set s1 = ActiveShape
    Dim grp1 As ShapeRange
    Set grp1 = ActiveSelection.UngroupEx
    Dim openopt As StructOpenOptions
    Set openopt = CreateStructOpenOptions
    With openopt.ColorConversionOptions
        .SourceColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 300% (ECI),Dot Gain 15%"
        .TargetColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 300% (ECI),Dot Gain 15%"
    End With
    Dim doc1 As Document
    Set doc1 = OpenDocumentEx("C:\objekt.ai", openopt)
    ActivePage.SelectableShapes.All.CreateSelection
      ActiveSelection.Outline.SetProperties Color:=CreateRGBColor(0, 0, 0)
      ActiveSelection.Outline.SetProperties Width:=0
      ActiveSelection.Fill.ApplyUniformFill CreateRGBColor(0, 0, 0)
      For Each sl In ActiveSelection.Shapes: sl.Curve.Nodes.All.Smoothen 20
      Next
    grp1.Copy
    doc1.Close
    Dim pasteopt As StructPasteOptions
    Set pasteopt = CreateStructPasteOptions
    With pasteopt.ColorConversionOptions
        .SourceColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 300% (ECI),Dot Gain 15%"
        .TargetColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 300% (ECI),Dot Gain 15%"
    End With
    Dim Paste1 As ShapeRange
    Set Paste1 = ActiveDocument.Pages(1).Layers("Ebene 1").PasteEx(pasteopt)
End Sub