'This is a silly procedure that cycles through all the shapes on a slide
'and checks for the HTML <B> or <I> tags. When it finds them, it bolds
'or italics the text.
Sub Htmlize()
Dim oSld As Slide
Dim oShp As Shape
Dim oTxtRng As TextRange
Dim openTag As TextRange
Dim closeTag As TextRange
Dim endRange As Long
Dim startRange As Long
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
Set oTxtRng = oShp.TextFrame.TextRange
Set openTag = oTxtRng.Find(findwhat:="<b>", _
MatchCase:=False)
Do While Not (openTag Is Nothing)
Set closeTag = oTxtRng.Find(findwhat:="</b>", _
MatchCase:=False)
If closeTag Is Nothing Then
endRange = oTxtRng.Length
Else
endRange = closeTag.Start - 1
oTxtRng.Characters(closeTag.Start, _
closeTag.Length).Delete
End If
startRange = openTag.Start
oTxtRng.Characters(startRange, _
endRange - startRange + 1) _
.Font.Bold = True
oTxtRng.Characters(openTag.Start, _
openTag.Length).Delete
Set openTag = oTxtRng.Find(findwhat:="<b>", _
MatchCase:=False)
Loop
End If
Next oShp
Next oSld
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
Set oTxtRng = oShp.TextFrame.TextRange
Set openTag = oTxtRng.Find(findwhat:="<i>", _
MatchCase:=False)
Do While Not (openTag Is Nothing)
Set closeTag = oTxtRng.Find(findwhat:="</i>", _
MatchCase:=False)
If closeTag Is Nothing Then
endRange = oTxtRng.Length
Else
endRange = closeTag.Start - 1
oTxtRng.Characters(closeTag.Start, _
closeTag.Length).Delete
End If
startRange = openTag.Start
oTxtRng.Characters(startRange, _
endRange - startRange + 1) _
.Font.Italic = True
oTxtRng.Characters(openTag.Start, _
openTag.Length).Delete
Set openTag = oTxtRng.Find(findwhat:="<i>", _
MatchCase:=False)
Loop
End If
Next oShp
Next oSld
End Sub
