CODEWITHSUNDEEP
vbapowerpoint
Marcus Riemer
Marcus Riemer

Reputation: 7688

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.

Upvotes: 0

Views: 590

Answers (1)

FunThomas
FunThomas

Reputation: 29146

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.

Upvotes: 1

Related Questions