PowerPoint macro to change words between quotes to italic needed

KarenK13 · #1 07-14-2019, 03:31 PM

Hello,

PowerPoint does not offer the same detailed features in Find & Replace as Word does. It also doesn't accept wild cards.

Therefore, I'm looking for a PowerPoint macro to change all words between quotes to italic. Would anyone be able to help?

Thanks,

Karen

JohnWilson · #2 07-15-2019, 05:23 AM

Not easy!

Here's a possible start for you to work on if you have multiple quotes in one textframe you will need to work on the pattern.

Code:

Sub regxz()

Dim oMatches As Object
Dim i As Long
Dim otr As TextRange2
Dim osld As Slide
Dim oshp As Shape
Dim regX As Object
Dim strmatch As String
Set regX = CreateObject("VBScript.RegExp")

' this allows for smart curly quotes but do not mix smart and straight
strmatch = "[" & Chr(147) & "," & Chr(34) & "]" & ".*" & "[" & Chr(148) & "," & Chr(34) & "]"
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame2.HasText Then Set otr = oshp.TextFrame2.TextRange
On Error Resume Next
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 If
Next oshp
Next osld
End Sub

KarenK13 · #3 07-15-2019, 06:51 AM

Quote:

Originally Posted by JohnWilson

Not easy!

Here's a possible start for you to work on

Code:

Sub regxz()

Dim oMatches As Object
Dim i As Long
Dim otr As TextRange2
Dim osld As Slide
Dim oshp As Shape
Dim regX As Object
Dim strmatch As String
Set regX = CreateObject("VBScript.RegExp")

' this allows for smart curly quotes
strmatch = "[" & Chr(147) & "," & Chr(34) & "]" & ".*" & "[" & Chr(148) & "," & Chr(34) & "]"
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame2.HasText Then Set otr = oshp.TextFrame2.TextRange
On Error Resume Next
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 If
Next oshp
Next osld
End Sub

Hi John,

You are absolutely amazing!!! I spent hours searching the internet and trying macros but I didn't know how to manipulate the code for italic.

This worked perfectly!!! Thanks so much!!!

Karen

JohnWilson · #4 07-15-2019, 07:03 AM

You should probably use ".*?" instead of ".*" BTW to turn off a greedy match

KarenK13 · #5 07-18-2019, 08:57 AM

Hi John,

I'm sorry to disturb you. The macro works great if copy is in a text box by itself. My colleague that designs the slides creates a shape then inserts the text box within the shape and all shapes are grouped on the one slide. Is there a way to manipulate the code to get within those shapes? Thanks so much for your assistance.

Karen

JohnWilson · #6 07-18-2019, 09:21 AM

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

KarenK13 · #7 08-21-2019, 03:13 PM

Hi John,

I had a new report and tried the macro. It changed words in quotes to italic which I needed but it also changed words between commas to italic. Can that be fixed?

Thanks so much,

Karen

JohnWilson · #8 08-22-2019, 08:02 AM

I'm out of Office right now but try replacing

strmatch = "[" & Chr(147) & "," & Chr(34) & "]" & ".*?" & "[" & Chr(148) & "," & Chr(34) & "]"

WITH

strmatch = "[" & Chr(147) & "|" & Chr(34) & "]" & ".*?" & "[" & Chr(148) & "|" & Chr(34) & "]"

KarenK13 · #9 08-22-2019, 12:50 PM

Hi John,

That seems to have worked. You're amazing!!! Thank you so much!!!

Karen

KJSK71 · #10 01-12-2020, 12:59 PM

John, Karen told me you are amazing and I need some help in excel. I posted it in the excel forum, but if you have time...would greatly appreciate your expertise.

https://www.msofficeforums.com/excel...tml#post147953
Thank you Kevin

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro needed to copy Powerpoint presentation and sections	Marrick13	PowerPoint	0	06-19-2017 07:34 AM
Help Needed with Macro to Change Formulas to Text Using Ranges	rsrasc	Excel Programming	2	11-29-2016 02:31 PM
How to replace straight quotes with smart quotes in existing document	PABwriter	Word	4	05-27-2016 03:36 PM
repel Macro vba help is needed for interactive powerpoint.	Mrs Blobby	PowerPoint	1	04-16-2014 10:58 PM
Regular Expressions: match words within quotes?	tinfanide	Word VBA	3	02-02-2013 10:07 PM