Header
PowerPoint tips, hints and tutorials that will change your presentations for ever!

INDEX

 

Jigsaws
Sounds
Video
Custom Shows
vba code
NaviSlides
Games for teachers
Bullets
Triggers
Security
Flash Cards
Multiple Instances
PowerPoint 2007
Mail Merge
Random events
Animation
Hyperlinks
Set spellcheck language


Home buttonTutorial buttonContact buttonProducts button

How to Italicise or Bold ANY Text in Quotes

There are two problems to overcome if you want to automate this.

A. vba doesn't really support fuzzy searches

B. Quotes can be straight quotes or more often curly quotes

We can use a RegX search to overcome the first problem and make a pattern that searches for both types of quote.

CODE

Sub regxer()
Dim L As Long
Dim iRow As Integer
Dim iCol As Integer
Dim otbl As Table
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.HasTable Then
Set otbl = oshp.Table
For iRow = 1 To otbl.Rows.Count
For iCol = 1 To otbl.Columns.Count
If otbl.Cell(iRow, iCol).Shape.TextFrame2.HasText Then
Set otr = otbl.Cell(iRow, iCol).Shape.TextFrame2.TextRange
Call fixTR(otr)
End If
Next iCol
Next iRow
Else
If oshp.HasTextFrame Then
If oshp.TextFrame2.HasText Then Set otr = oshp.TextFrame2.TextRange
Call fixTR(otr)
End If
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

'34 is a straight double quote and 147 148 curly quotes
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

'use Bold=True if you need to bold
otr.Characters(oMatches(i).FirstIndex + 1, Len(oMatches(i).Value)).Font.Italic = True
Next i
End With
End Sub

 

 

Back to the Index Page

POWERPOINT BLOG

Articles on your favourite sport

Free Microsoft PowerPoint Advice, help and tutorials, Template Links
This website is sponsored by Technology Trish Ltd
© Technology Trish 2007
Registered in England and Wales No.5780175
PowerPoint® is a registered trademark of the Microsoft Corporation