Word Macro: Insert Circle Shape over selected text

[syl3786]

Hi everyone,



I am currently developing a word macro to insert a specific circle shape over selected text.

Here's the code:

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

I've noticed that the circle shape is not positioned correctly. It consistently appears on the left-hand side of the selected text but not over the selected text. Does anyone have any suggestions on how to improve the accuracy of its placement? Any help would be greatly appreciated!

[Guessed]

I see you have been working on this problem for a while

Would you consider a box rather than a circle?

Sub Macro1()
  With Selection.Font.Borders(1)
    .LineStyle = Options.DefaultBorderLineStyle
    .LineWidth = Options.DefaultBorderLineWidth
    .Color = Options.DefaultBorderColor
  End With
End Sub

[syl3786]

Originally Posted by Guessed

I see you have been working on this problem for a while

Would you consider a box rather than a circle?

Sub Macro1()
  With Selection.Font.Borders(1)
    .LineStyle = Options.DefaultBorderLineStyle
    .LineWidth = Options.DefaultBorderLineWidth
    .Color = Options.DefaultBorderColor
  End With
End Sub

I appreciate your response. I actually found a way to accurately place a circle shape over specific text based on an Excel sheet, but it's limited to specific characters, a set circle size, and some adjustments by Word VBA code. However, I want the macro to calculate the position and size of the circle shape automatically. The only part I'm struggling with is the x-axis position, which isn't accurate.

I don't want to rely on Word VBA adjustments of the position since such action shouls be customized each time. My original macro is designed to add a circle shape over selected text. The issue is that the character, font size, and line spacing of the selected text can vary greatly, making accurate calculation crucial.

By the way, I did consider your suggestion of putting a circle shape in a text box and then adding the text box over the selected text. However, I think it would be much more complicated to calculate, so I'm exploring other options.

Thank you again for your suggestion, and I appreciate your input.

[vivka]

Hi! Why don't you use the code proposed by Guessed in post

https://www.msofficeforums.com/181470-post2.html
It seems to work correctly.

[syl3786]

Originally Posted by vivka

Hi! Why don't you use the code proposed by Guessed in post

https://www.msofficeforums.com/181470-post2.html
It seems to work correctly.

That is intended for a different purpose, specifically to circle a specific text with a specific format. While the 'Guessed' version may work, I've found that when I run the test on my computer, the circle shape will fly over randomly. I suspect this issue may be due to a language difference.

[Guessed]

I think it might be less of a language difference and more related to the text alignment.

Try the macro on text that is left aligned vs fully justified vs right aligned. Do you get consistent results for one alignment vs another alignment? On my Australian English text doc, I get a better result on Left Aligned text but not with other alignments. For some reason, centred text circles are wider than left aligned text of the same size.

[syl3786]

Originally Posted by Guessed

I think it might be less of a language difference and more related to the text alignment.

Try the macro on text that is left aligned vs fully justified vs right aligned. Do you get consistent results for one alignment vs another alignment? On my Australian English text doc, I get a better result on Left Aligned text but not with other alignments. For some reason, centred text circles are wider than left aligned text of the same size.

I'm aiming to create a macro that can adapt to various situations through calculation. While I haven't attempted this yet, I'm looking to explore ways to make it flexible and applicable to different scenarios.

[syl3786]

Originally Posted by josenwily

To improve the circle's placement, adjust the padding values and re-calculate the x and y positions to align more accurately with the selected text. Try refining the x and y calculations to better match the text's bounding box.

I attempted to improve the circle's placement by adjusting the padding values and recalculating the x and y positions to better align with the selected text. Unfortunately, I was unable to achieve the desired accuracy. That's why i ask for solution here.