Give this version a try
Code:
Sub AddCircleShape()
Dim rng As Range, stri As String, shp As Shape
Dim padding As Long, rightCount As Integer
Dim X As Long, Y As Long, myWidth As Long, myHeight As Long
Set rng = ActiveDocument.Range
stri = "AGREE/"
padding = 2
With rng.Find
.Text = stri
.Font.Underline = True
.Execute
While .Found
' Calculate the position and size of the circle
myHeight = IIf(rng.ParagraphFormat.LineSpacing > rng.Font.Size, rng.ParagraphFormat.LineSpacing, rng.Font.Size * 1.2)
Y = rng.Information(wdVerticalPositionRelativeToPage) - myHeight / 10 + myHeight - (rng.Font.Size * 1.2)
myHeight = rng.Font.Size * 1.2 ' 120%
X = rng.Information(wdHorizontalPositionRelativeToPage) - padding
rng.Collapse wdCollapseEnd
myWidth = rng.Information(wdHorizontalPositionRelativeToPage) + padding - X
myHeight = myHeight + padding * 2
' Add the circle shape
Set shp = ActiveDocument.Shapes.AddShape(msoShapeOval, X, Y, myWidth, myHeight)
With shp
.ZOrder msoSendBehindText
.Fill.Transparency = 1 ' Full transparency
.Line.ForeColor.RGB = RGB(0, 112, 192)
.Line.Weight = 1
.Line.Visible = msoTrue
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
End With
rng.Collapse wdCollapseEnd
.Execute
Wend
End With
End Sub