Formatting a character in a particular position of a string

[h2whoa]

Hi all.

I have some code that allows me to search for some text and then apply superscript or subscript formatting (or apply neither). This was to get round PowerPoint lacking Word's find and replace functionality that allows you to change formatting throughout. I have largely just mashed together code I have found in other places to make this work, so I'm not claiming credit for this code!

What would be really useful is if the code could find a specified string and then apply formatting to a specific character within it. As a basic example, if I have H2O written throughout the deck, changing all 2s in the deck to subscript is probably not ideal. I just want 2s in H2O to be subscript.

So, I would really appreciate help changing the code below to search for a given string (such as H2O) then apply the chosen formatting to only the character at a specified position (position 2, in this case).

If anyone can help, I'd be super grateful. Like I say, I've cobbled together this code from a couple of different places so it is a) probably very clunky and b) not my own work for the most part; I claim no credit!


Sub Super_Or_Sub()
Dim oshp As Shape
Dim osld As Slide
Dim oTMP As TextRange
Dim lngPos As Long
Dim strResult As String
Dim strFormat As String
strResult = InputBox("Text to change")
strFormat = InputBox("Font format: Super, sub or none?")


If strFormat = "Super" Then
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
Set txtRng = oshp.TextFrame.TextRange
Set foundText = txtRng.Find(FindWhat:=strResult)


Do While Not (foundText Is Nothing)
With foundText
.Font.Superscript = True
Set foundText = _
txtRng.Find(FindWhat:=strResult, _
After:=.Start + .Length - 1)
End With
Loop
End If
End If
Next oshp
Next osld


Else
If strFormat = "super" Then
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
Set txtRng = oshp.TextFrame.TextRange
Set foundText = txtRng.Find(FindWhat:=strResult)


Do While Not (foundText Is Nothing)
With foundText
.Font.Superscript = True
Set foundText = _
txtRng.Find(FindWhat:=strResult, _
After:=.Start + .Length - 1)
End With
Loop
End If
End If
Next oshp
Next osld


Else
If strFormat = "Sub" Then
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
Set txtRng = oshp.TextFrame.TextRange
Set foundText = txtRng.Find(FindWhat:=strResult)


Do While Not (foundText Is Nothing)
With foundText
.Font.Subscript = True
Set foundText = _
txtRng.Find(FindWhat:=strResult, _
After:=.Start + .Length - 1)
End With
Loop
End If
End If
Next oshp
Next osld


Else
If strFormat = "sub" Then
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
Set txtRng = oshp.TextFrame.TextRange
Set foundText = txtRng.Find(FindWhat:=strResult)


Do While Not (foundText Is Nothing)
With foundText
.Font.Subscript = True
Set foundText = _
txtRng.Find(FindWhat:=strResult, _
After:=.Start + .Length - 1)
End With
Loop
End If
End If
Next oshp
Next osld

Else
If strFormat = "None" Then
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
Set txtRng = oshp.TextFrame.TextRange
Set foundText = txtRng.Find(FindWhat:=strResult)


Do While Not (foundText Is Nothing)
With foundText
.Font.Subscript = False
.Font.Superscript = False
Set foundText = _
txtRng.Find(FindWhat:=strResult, _
After:=.Start + .Length - 1)
End With
Loop
End If
End If
Next oshp
Next osld

Else
If strFormat = "none" Then
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
Set txtRng = oshp.TextFrame.TextRange
Set foundText = txtRng.Find(FindWhat:=strResult)


Do While Not (foundText Is Nothing)
With foundText
.Font.Subscript = False
.Font.Superscript = False
Set foundText = _
txtRng.Find(FindWhat:=strResult, _
After:=.Start + .Length - 1)
End With
Loop
End If
End If
Next oshp
Next osld

End If
End If
End If
End If
End If
End If


End Sub