Sub CircleSelectedText()

    Dim padding As Long
    Dim myRange As range
    Set myRange = Selection.range
    
    Dim x As Long
    Dim y As Long
    Dim myWidth As Long
    Dim myHeight As Long

    ' Calculate height
    myHeight = IIf(myRange.ParagraphFormat.linespacing > myRange.Font.Size, _
                   myRange.ParagraphFormat.linespacing, _
                   myRange.Font.Size)  ' 120% of the font size for height

    ' Calculate width
    myWidth = Selection.Characters.Count * myRange.Font.Size * 1.15 ' More accurate width calculation

    ' Get the x and y positions relative to the page
    x = myRange.Information(wdHorizontalPositionRelativeToPage)
    y = myRange.Information(wdVerticalPositionRelativeToPage)
    
    ' Add padding to ensure the circle covers the selected text
    padding = Selection.Characters.Count
    x = x + padding * 3
    y = y - padding
    myWidth = myWidth + padding * 2
    myHeight = myHeight + padding * 2
    
    ' Add the circle shape over the selected text
    With ActiveDocument.Shapes.AddShape(msoShapeOval, x, y, myWidth, myHeight)
        .Fill.Transparency = 1 ' Full transparency
        .Line.ForeColor.RGB = RGB(0, 112, 192)
        .Line.Weight = 1
        .Line.Visible = msoTrue
    End With
End Sub