TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

Sub FixAllDescenders()
' Removes underlines from all descenders in the presentation

    Dim oSl As Slide
    Dim oSh As Shape

    For Each oSl In ActivePresentation.Slides
        For Each oSh In oSl.Shapes
            If oSh.HasTextFrame Then
                If oSh.TextFrame.HasText Then
                    FixDescenders oSh
                End If
            End If
        Next
    Next

End Sub

Sub FixDescenders(oSh As Shape)
' Removes underlines from descenders in just the current shape

    Dim x As Long
    Dim oChar As TextRange
    With oSh
    If .HasTextFrame Then
    If .TextFrame.HasText Then
      For x = 1 To Len(.TextFrame.TextRange.Text)
        If IsDescender(Mid$(.TextFrame.TextRange.Text, x, 1)) Then
          .TextFrame.TextRange.Characters(x, 1).Font.Underline = False
        End If
      Next
    End If
    End If
    End With
End Sub

Function IsDescender(sCharacter As String) As Boolean
    Dim sDescenders as String
    sDescenders = "gjpqy"
    If InStr(sDescenders, sCharacter) > 1 Then
        IsDescender = True
    Else
        IsDescender = False
    End If
End Function