View Single Post
 
Old 04-22-2024, 04:58 AM
syl3786 syl3786 is offline Windows 10 Office 2019
Advanced Beginner
 
Join Date: Jan 2023
Posts: 97
syl3786 is on a distinguished road
Default

Quote:
Originally Posted by Guessed View Post
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
Thank you for your assistance. I attempted to use your code, but the circle seems to be flying over a random area of the document and the size of the circle isn't accurate.
Reply With Quote