Search code examples
vbapowerpoint

Changing colour of text segments in a powerpoint presentation


I have a Powerpoint-Slide with pasted, formatted source code in the form of text shapes. Sadly the contrast of some part of that text is bad on a projector, so I would like to change every colour occurence for a specific font with a different colour. In this specific example I want to replace the orange colour:

Picture of source code with some low contrast highlights

Iterating over all shapes and accessing the whole text of a shape is not a problem, but I can't find any property that allows me to enumerate over the styled text segments:

Sub ChangeSourceColours()
    For Each pptSlide In Application.ActivePresentation.Slides
        For Each pptShape In pptSlide.Shapes
            If (pptShape.Type = 1) And (pptShape.TextFrame.TextRange.Font.Name = "Consolas") Then
                ' Iterate over styled segments and change them if the previous colour is orangey
                MsgBox pptShape.TextFrame.TextRange
            End If
        Next
    Next
End Sub

The TextRange2 property looked helpful at a first glance, but looking at the variables in the debugger I see nothing that looks like a series of formatted segments. I would expect to find something like <span> in HTML to check and possibly change the colour.


Solution

  • The textFrame2.textRange.Font is valid for the whole text. If you want to access the single characters and their individual formatting, you need to access textRange.Characters.

    The following routine changes the text color for all characters that have a specific color to a new color:

    Sub ChangeTextColor(sh As Shape, fromColor As Long, toColor As Long)
        Dim i As Long
        With sh.TextFrame2.TextRange
            For i = 1 To .Characters.Length
                If .Characters(i).Font.Fill.ForeColor.RGB = fromColor Then
                    .Characters(i).Font.Fill.ForeColor.RGB = toColor
                End If
            Next i
        End With
    End Sub
    

    You call it from your code with

    Dim pptSlide as Slide
    For Each pptSlide In Application.ActivePresentation.Slides
        Dim pptShape As Shape
        For Each pptShape In pptSlide.Shapes
            If (pptShape.Type = 1) And (pptShape.TextFrame.TextRange.Font.Name = "Consolas") Then
                ChangeTextColor pptShape, RGB(255, 192, 0), vbRed
            End If
        Next
    Next
    

    You will have to adapt the RGB-Code to the orange you are using, or instead of using RGB, you can use ObjectThemeColor. To avoid a type mismatch, you need to declare the pptShape variable as Shape - you should declare all your variables and use Option Explicit anyhow.

    Note that you can use the ChangeTextColor-routine also in Excel (and probably also in Word). Shapes are defined similar in Excel and Powerpoint. Advantage in Excel: You can use the macro recorder to get some insights how a Shape can be used in Office VBA.