Substitua a cor do texto específico por outras cores em vários slides da mesma apresentação do Powerpoint

0

Estou fazendo uma apresentação na qual tenho mais de 200 slides. Evevry slide contém várias linhas. Em cada linha de cada slide, há uma parte do texto destacada para a cor azul. Eu quero mudar essa cor azul para alguma outra cor.

Eu quero que essa alteração seja refletida em todos os slides, o que significa que a cor específica deve ser substituída pela minha nova cor e não deve afetar a cor do outro texto porque ela está em outra cor porque quero enfatizar esse ponto.

Em resumo, substituir cores específicas em partes específicas do texto por outras cores em todos os slides.

    
por Programmer 04.09.2015 / 19:11

1 resposta

1

Aqui está uma resposta da FAQ do PowerPoint no link

Problema

Você tem muito texto em vários slides. Algumas delas foram configuradas para uma cor que você precisa alterar agora. Isso vai ajudar.

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
    
por 05.09.2015 / 18:42