TPE

Tavvafi@gmail.com

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

Sub DoubleUnderline()

    Dim oRng As TextRange
    Dim lLineCount As Long
    Dim oLine As Shape
    Dim dOffset As Double

    dOffset = 4     ' space between underlines in points
                    ' change if you like

    With ActiveWindow.Selection.TextRange
        For lLineCount = 1 To .Lines.Count
            Set oRng = .Lines(lLineCount)
            With oRng
                Set oLine = ActiveWindow.Selection.SlideRange.Shapes.AddLine( _
                    .BoundLeft, .BoundTop + .Boundheight, _
                    .BoundLeft + .Boundwidth, .BoundTop + .Boundheight)
                Call oLine.Tags.Add("Underline", "YES")
                With oLine.Duplicate(1)
                    .Left = oLine.Left
                    .Top = oLine.Top + dOffset
                    Call .Tags.Add("Underline", "YES")
                End With
            End With
        Next
    End With

End Sub

Sub UnUnderline()
' Removes underlines added by DoubleUndies

    Dim oSh As Shape
    Dim x As Long

    With ActiveWindow.Selection.SlideRange(1)
        For x = .Shapes.Count To 1 Step -1
            Set oSh = .Shapes(x)
            If oSh.Tags("Underline") = "YES" Then
                oSh.Delete
            End If
        Next
    End With
End Sub