Change distance from text to underlines
Problem
The distance/offset from PowerPoint's text to its underlines doesn't suit your taste.
Solution
A bit of VBA will let you define how far from the text you want underlines to appear and to modify the formatting of the lines to suit you.
RUN THIS ONLY on a COPY of your presentation.. If you don't like the results immediately after running it, click anywhere in the presentation and press CTRL+Z to undo whatever the VBA code has done.
What it does
The code below looks for underlined text on each slide and when it finds some, it adds a new line shape at an offset that you choose, formats it in a way that you can define (thickness, color, etc) and then removes the originally applied underline.
Sub ModifyUnderlines()
Dim oSh As Shape
Dim oSl As Slide
Dim x As Long
Dim oShUnderline As Shape
Dim LineLeft As Single
Dim LineWidth As Single
Dim LineYPos As Single
Dim sngOffset As Single
' Change this to change the offset of the line from the original
sngOffset = 4 ' points
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
For x = oSh.TextFrame.TextRange.Runs.Count To 1 Step -1
If oSh.TextFrame.TextRange.Runs(x).Font.Underline = True Then
With oSh.TextFrame.TextRange.Runs(x)
LineLeft = .BoundLeft
LineWidth = .BoundLeft + .BoundWidth
LineYPos = .BoundTop + .BoundHeight + sngOffset
End With
Set oShUnderline = oSl.Shapes.AddLine(LineLeft, LineYPos, _
LineWidth, LineYPos)
With oShUnderline
' Format the line as desired
.Line.Visible = True
.Line.ForeColor.RGB = RGB(255, 0, 0)
.Line.Weight = 2 ' points
End With
' and remove the PPT-created underline
oSh.TextFrame.TextRange.Runs(x).Font.Underline = False
End If
Next
End If
End If
Next
Next
End Sub
See How do I use VBA code in PowerPoint? to learn how to use this example code.