Hallo zusammen,

mit folgendem Code versuche ich, die Farbe, die das Objekt hat, das vor Start des Makros ausgewählt ist, durch die Farbe des Objektes zu ersetzen, das während der Laufzeit des Makros ausgewählt wird - bei allen Objekten in der Präsentation.

Leider erfolgt trotz ausbleibender Fehlermeldung keine Anpassung der Farbe. Habt ihr dazu Ideen/ Lösungsansätze?

Sub FarbeErsetzen()

Dim sld As Slide

Dim oshp As shape

Dim oshpR As ShapeRange

Dim lngCol_Alt As Long
Dim iR_Alt As Integer
Dim iG_Alt As Integer
Dim iB_Alt As Integer

Dim lngCol_Neu As Long
Dim iR_Neu As Integer
Dim iG_Neu As Integer
Dim iB_Neu As Integer

On Error GoTo ErrorHandler ' Error Handling

If ActiveWindow.Selection.ShapeRange.Count <> 1 Then 'Abbruch, falls mehr als ein Objekt ausgewählt ist
    
    MsgBox "Es muss ein Objekt ausgewählt sein.", vbCritical
    
    Exit Sub
    
ElseIf ActiveWindow.Selection.Type <> ppSelectionShapes Then 'Abbruch, falls keine Autoform ausgewählt ist

    MsgBox "Es muss ein Objekt ausgewählt sein.", vbCritical

    Exit Sub

Else

   Set oshpR = ActiveWindow.Selection.ShapeRange
   
   
    lngCol_Alt = oshpR(1).Fill.ForeColor 'Erfassung der Farbe, die ersetzt werden soll
    
    iR_Alt = lngCol_Alt Mod 256
    iG_Alt = (lngCol_Alt \ 256) Mod 256
    iB_Alt = (lngCol_Alt \ 256 \ 256) Mod 256
   
   ActiveWindow.Selection.Unselect
   
   
    Do While ActiveWindow.Selection.Type <> ppSelectionShapes
        DoEvents
        
    Loop
    
    With ActiveWindow.Selection
                If .Type = ppSelectionShapes Then
                                     
                    
                        lngCol_Neu = oshpR(1).Fill.ForeColor 'Erfassung der Farbe, die die alte Farbe ersetzen soll
    
                        iR_Neu = lngCol_Neu Mod 256
                        iG_Neu = (lngCol_Neu \ 256) Mod 256
                        iB_Neu = (lngCol_Neu \ 256 \ 256) Mod 256
                    
                    
                End If
    End With
   
   ActiveWindow.Selection.Unselect
   
   For Each sld In ActivePresentation.Slides.Range
   
        For Each oshp In sld.Shapes 'Iteration durch alle Objekte für Abgleich
            With oshp
                If .Fill.ForeColor.RGB = RGB(iR_Alt, iG_Alt, iB_Alt) Then
                .Fill.ForeColor.RGB = RGB(iR_Neu, iG_Neu, iB_Neu) 'Falls Objekt mit zu ersetzender Farbe: alte Farbe mit neuer Farbe ersetzen
            
                End If
            End With
    
        Next oshp
   Next sld
    
End If

Exit Sub 'Wichtig, da sonst Error Handling-Code ausgeführt wird, obwohl kein Fehler vorliegt
ErrorHandler:
 MsgBox "Es muss ein Objekt ausgewählt sein.", vbCritical
 'Resume Next

End Sub