Thema Datum  Von Nutzer Rating
Antwort
Rot VBA Powerpoint: Austausch einer Farbe in ganzer Präsentation
02.03.2024 00:13:15 Max
Solved
02.03.2024 01:29:24 Gast90285
*****
Solved
02.03.2024 07:34:53 Gast60354
Solved

Ansicht des Beitrags:
Von:
Max
Datum:
02.03.2024 00:13:15
Views:
165
Rating: Antwort:
 Nein
Thema:
VBA Powerpoint: Austausch einer Farbe in ganzer Präsentation

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


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot VBA Powerpoint: Austausch einer Farbe in ganzer Präsentation
02.03.2024 00:13:15 Max
Solved
02.03.2024 01:29:24 Gast90285
*****
Solved
02.03.2024 07:34:53 Gast60354
Solved