View Single Post
 
Old 04-22-2024, 04:13 AM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 4,159
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

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
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote