CODEWITHSUNDEEP
vbavstopowerpoint
Todd Main
Todd Main

Reputation: 29155

Format multiple text selections in PowerPoint

I'm trying to see if there is a way to programmatically access multiple text selections in shapes/textboxes in PowerPoint.

The scenario is this - create a textbox that has the words "one two three" inside. Now, with the Ctrl button held down, select the words "one" and "three" (but not "two").

The ActiveWindow.Selection.TextRange and ActiveWindow.Selection.TextRange2 objects only provide a single selection. I was hoping it would provide both selections, like in a series of Runs, Paragraphs or whatnot. The ActiveWindow.Selection.ShapeRange object doesn't provide anything on this well - it's still a single shape.

In the PPT client, when you have multiple (disconnected) text selections, you can perform the same actions on them, like setting the font color to red. I'm looking for the same access, but programmatically - VBA, C#/VB.NET, VSTO, - any of those technologies are fine if you have a way to do this.

Upvotes: 4

Views: 695

Answers (2)

konahn
konahn

Reputation: 371

It's a pity that ActiveWindow.Selection.TextRange only returns the last selected textrange. I found that ActiveWindow.Selection.Cut or .Copy manage to process all the selected textrange.

So, if any part of the text content is not duplicated, we can find all the selected textrange by searching for the copied text:

    Sub test1()

    Dim shp As Shape
    Dim tr As TextRange2
    Dim i As Integer
    Dim lines() As String
    
    If ActiveWindow.Selection.Type <> ppSelectionText Then Exit Sub
    
    ActiveWindow.Selection.Copy
    
    'get copied text from Clipboard
    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        lines() = Split(.GetText, vbNewLine)
    End With
    
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    
    For i = LBound(lines) To UBound(lines)
        Set tr = shp.TextFrame2.TextRange.Find(lines(i))
        If Not tr Is Nothing Then
            'Here, do whatever you want to do with the textrange
            tr.Font.Fill.ForeColor.RGB = rgbYellow
            Debug.Print tr.Text, tr.Start, tr.Length
        End If
    Next

    End Sub

But this 'searching' method fails to find the exact textrange when the text is like "Blah Blah Blah...."

Anothor method is to make a copy of the original shape and to compare the two textareas:

    Sub test2()

    Dim shp As Shape, dup As Shape
    Dim tr As TextRange2, trDup As TextRange2
    Dim p As Long, k As Long
    Dim lines() As String
    
    If ActiveWindow.Selection.Type <> ppSelectionText Then _
        MsgBox "Select some multiple textrange first": Exit Sub
    
    'duplicate the current shape
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    Set dup = shp.Duplicate(1)
    Set trDup = dup.TextFrame2.TextRange
    
    'cut selection to Clipboard
    ActiveWindow.Selection.Cut
    Set tr = shp.TextFrame2.TextRange
    
    'get cut text from Clipboard
    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        lines() = Split(.GetText, vbNewLine)
    End With
    
    'compare the original textrange with the copied text
    For k = LBound(lines) To UBound(lines)
        p = 1
        Do While p <= trDup.Characters.Count
            If trDup.Characters(p) <> tr.Characters(p) Then
                DoEvents
                trDup.Characters(p, Len(lines(k))).Copy
                DoEvents
                tr.Characters(p).InsertAfter " "
                tr.Characters(p).Paste
                DoEvents
                With tr.Characters(p, Len(lines(k)))
                    'Here, do whatever you want to do with the textrange
                    .Font.Fill.ForeColor.RGB = rgbYellow
                    .Font.Bold = msoTrue
                End With
                Exit Do
            End If
            p = p + 1
        Loop
    Next k

    'delete the tempoary shape
    dup.Delete
    
    End Sub

This 'Duplicating and Comparing' method succeeds to get all the multiple textareas even when some part of the text content is duplicated several times.

Notice:

  1. Note that lots of DoEvents functions are added since textrange.copy / .paste sometimes fails once in a while.
  2. Also note that, if you select textranges in a random order, this method also fails because it compares all the characters from the first one to the last.

I hope these work-arounds might help someone frustrated.

Upvotes: 0

Shyam Pillai
Shyam Pillai

Reputation: 586

You cannot do it because of lack of support in the object model. Take a look at this kb article - https://social.msdn.microsoft.com/Forums/office/en-US/98c90979-fff7-4d0f-9499-6e6e730d9ea4/disjoint-selection-of-text?forum=worddev. Though it pertains to Word, the limitations are similarly applicable to PowerPoint.

Upvotes: 3

Related Questions