View Single Post
 
Old 07-18-2019, 09:21 AM
JohnWilson JohnWilson is offline Windows 10 Office 2016
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,912
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

You could try something based on this:

Code:
Sub regxz()

Dim L As Long
Dim otr As TextRange2
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
Select Case oshp.Type
Case Is = msoGroup
For L = oshp.GroupItems.Count To 1 Step -1
If oshp.GroupItems(L).HasTextFrame Then
If oshp.GroupItems(L).TextFrame2.HasText Then Set otr = oshp.GroupItems(L).TextFrame2.TextRange
End If
Call fixTR(otr)
Next L
Case Else
If oshp.HasTextFrame Then
If oshp.TextFrame2.HasText Then Set otr = oshp.TextFrame2.TextRange
Call fixTR(otr)
End If
End Select
Next oshp
Next osld
End Sub

Sub fixTR(otr As TextRange2)
On Error Resume Next
Dim oMatches As Object
Dim i As Long
Dim regX As Object
Dim strmatch As String
strmatch = "[" & Chr(147) & "," & Chr(34) & "]" & ".*?" & "[" & Chr(148) & "," & Chr(34) & "]"
Set regX = CreateObject("VBScript.RegExp")
With regX
    .Global = True
    .IgnoreCase = True
    .Pattern = strmatch
    Set oMatches = .Execute(otr)
    For i = 0 To oMatches.Count - 1
       otr.Characters(oMatches(i).FirstIndex + 1, Len(oMatches(i).Value)).Font.Italic = True
    Next i
End With
End Sub
__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote