web-dev-qa-db-ja.com

同じPowerPointプレゼンテーションの複数のスライドで特定のテキストの色を他の色に置き換えます

200枚以上のスライドがあるプレゼンテーションをしています。 Evevryスライドには複数の行が含まれています。各スライドの各行には、青色で強調表示されているテキストの一部があります。その青い色を他の色に変えたいです。

この変更をすべてのスライドに反映させたいのです。つまり、特定の色を新しい色に置き換え、他のテキストの色に影響を与えないようにする必要があります。その点を強調したいからです。

つまり、テキストの特定の部分の特定の色をすべてのスライドの他の色に置き換えます。

microsoft-officecolorsmicrosoft-powerpointtext-formattingpresentations
1
Programmer

これがPowerPointからの回答ですFAQ at http://www.pptfaq.com

問題

たくさんのスライドにたくさんのテキストがあります。一部は、変更が必要な色に設定されています。これは役に立ちます。

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
2
Steve Rindsberg