Umrisslinie vektorisierte Grafik

[koter]

Hallo Salty,

...es hat ca eine halbe Stunde gedauert...

Bei langen Ausführungszeiten kann es sich lohnen, die Optimierung einzuschalten:

Code:

Sub Macro1()
    Dim Auswahl As ShapeRange
    
    Set Auswahl = ActiveSelectionRange
    Call zeitMessung(True) ' Zeitmessung, kann gelöscht werden
    Optimization = True ' Optimierung einschalten
    For i = 1 To Auswahl.Count
        If Auswahl(i).Outline.Type > cdrNoOutline And Auswahl(i).Fill.Type = cdrUniformFill Then
            Auswahl(i).Outline.Color = Auswahl(i).Fill.UniformColor
        End If
    Next i
    Optimization = False 'Optimierung ausschalten
    ActiveWindow.Refresh ' Bildschirm auffrischen
    Call zeitMessung ' Zeitmessung, kann gelöscht werden
End Sub

Sub zeitMessung(Optional start As Boolean)
    Static t1
    If start Then
        t1 = Time
    Else
        MsgBox Format(Time - t1, "hh:mm:ss")
    End If
End Sub

Bei einem Test brauchte das Makro ohne Optimierung 1:33 Minuten.
Mit Optimierung brauchte es nur 6 Sekunden.

Die Sub zeitMessung und die Befehle zum Aufruf derselben kannst Du löschen, Sie dienen nur zum Experimentieren.

Gruß

Koter