Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 04-22-2024, 04:13 AM
Guessed's Avatar
Guessed Guessed is offline Word Macro issues (Circle Shape) Windows 10 Word Macro issues (Circle Shape) Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 4,185
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
  #2  
Old 04-22-2024, 04:58 AM
syl3786 syl3786 is offline Word Macro issues (Circle Shape) Windows 10 Word Macro issues (Circle Shape) Office 2019
Advanced Beginner
Word Macro issues (Circle Shape)
 
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
Reply



Similar Threads
Thread Thread Starter Forum Replies Last Post
Word Macro issues (Circle Shape) Seeking Assistance with Word Macro to Add Transparent, Blue Line Circle Shape syl3786 Word VBA 5 01-21-2024 03:41 AM
Word Macro issues (Circle Shape) put "page numbers" in a shape (e.g. circle) without missing the numbers in the document Abbas Word 1 07-26-2022 07:04 AM
Word 2016 Multi-file Macro issues IneedHelpWithWord Word VBA 1 08-08-2017 09:29 PM
Issues with text in circle shapes that I am having damefrombrum Word 0 12-01-2015 08:05 PM
Assign Macro to Shape in Word 2013 tunes10590 Word VBA 8 01-29-2015 06:26 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 06:34 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft