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
|