Ersetzen Sie die angegebene Textfarbe in mehreren Folien derselben Powerpoint-Präsentation durch eine andere Farbe

2564
Programmer

Ich habe eine Präsentation, in der ich mehr als 200 Folien habe. Jede Folie enthält mehrere Zeilen. In jeder Zeile jeder Folie befindet sich ein Teil des Textes, der blau markiert ist. Ich möchte diese blaue Farbe in eine andere Farbe ändern.

Ich möchte, dass sich diese Änderung in allen Folien widerspiegelt. Das bedeutet, dass eine bestimmte Farbe durch meine neue Farbe ersetzt werden sollte und keine andere Textfarbe beeinflusst werden sollte, da sie in einer anderen Farbe dargestellt ist, da ich diesen Punkt hervorheben möchte.

Kurz gesagt: Ersetzen einer bestimmten Farbe in einem bestimmten Textabschnitt durch eine andere Farbe in allen Folien.

0

1 Antwort auf die Frage

1
Steve Rindsberg

Hier ist eine Antwort aus der PowerPoint-FAQ unter http://www.pptfaq.com

Problem

Sie haben viel Text in vielen Folien. Für einige davon wurde eine Farbe festgelegt, die Sie jetzt ändern müssen. Das wird helfen. 

Option Explicit  Sub ChangeTextColors()  Dim oSl As Slide Dim oSh As Shape Dim lCol As Long Dim lRow As Long Dim x As Long  Dim lOldColor As Long Dim lNewColor As Long  ' EDIT THESE TO THE COLORS YOU WANT TO CHANGE FROM and TO lOldColor = RGB(100, 200, 100) lNewColor = RGB(200, 100, 200)  For Each oSl In ActivePresentation.Slides For Each oSh In oSl.Shapes  If oSh.HasTextFrame Then If oSh.TextFrame.HasText Then Call ChangeTextRange(oSh.TextFrame, lOldColor, lNewColor) End If End If  If oSh.HasTable Then With oSh.Table For lCol = 1 To .Columns.Count For lRow = 1 To .Rows.Count Call ChangeTextRange(.Cell(lRow, lCol).Shape.TextFrame, lOldColor, lNewColor) Next Next End With End If  ' this part is commented out because PPT 's buggy and ... sorry ... haven't quite figured it out yet: ' If oSh.HasSmartArt Then ' With oSh.SmartArt ' For x = 1 To .Nodes.Count ' Call ChangeTextRange(.Nodes(x).TextFrame2, lOldColor, lNewColor) ' Next ' End With ' End If  If oSh.HasChart Then ' You're on your own, my friend End If  Next Next  End Sub  Sub ChangeTextRange(oTextFrame As Object, lOldColor As Long, lNewColor As Long)  Dim x As Long  With oTextFrame.TextRange For x = 1 To .Runs.Count If .Runs(x).Font.Color.RGB = lOldColor Then .Runs(x).Font.Color.RGB = lNewColor End If Next End With  End Sub

Verwandte Probleme