#1
|
|||
|
|||
Word Macro issues (Circle Shape)
Hello all,
Presently, I am utilizing a particular Word macro to add a distinct circle shape over specific text: Code:
Sub AddCircleShape() Dim rng As Range Dim stri As String Dim shp As Shape Dim padding As Long Dim rightCount As Integer Dim X, Y, myWidth, myHeight Set rng = ActiveDocument.Range stri = "AGREE/" With rng.Find .Text = stri .Font.Underline = True .Execute While .found rng.Select ' Calculate the position and size of the circle myHeight = IIf(Selection.ParagraphFormat.LineSpacing > rng.Font.Size, Selection.ParagraphFormat.LineSpacing, rng.Font.Size + rng.Font.Size / 5) Y = rng.Information(wdVerticalPositionRelativeToPage) - myHeight / 10 + myHeight - rng.Font.Size - rng.Font.Size / 5 myHeight = rng.Font.Size + rng.Font.Size / 5 ' 120% X = rng.Information(wdHorizontalPositionRelativeToPage) rng.Collapse wdCollapseEnd myWidth = rng.Information(wdHorizontalPositionRelativeToPage) - X myWidth = myWidth - 40 padding = 2 X = X - padding Y = Y - padding myWidth = myWidth + padding * 2 myHeight = myHeight + padding * 2 ' Add the circle shape Set shp = ActiveDocument.Shapes.AddShape(msoShapeOval, X, Y, myWidth, myHeight) With shp .Fill.Transparency = 1 ' Full transparency .Line.ForeColor.RGB = RGB(255, 0, 0) .Line.Weight = 1 .Line.Visible = msoTrue End With rng.Collapse wdCollapseEnd .Execute Wend End With rightCount = 30 For Each shp In ActiveDocument.Shapes If shp.AutoShapeType = msoShapeOval Then If shp.Line.ForeColor.RGB = RGB(255, 0, 0) Then shp.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage shp.RelativeVerticalPosition = wdRelativeVerticalPositionPage shp.Left = shp.Left + rightCount End If End If Next shp For Each shp In ActiveDocument.Shapes If shp.AutoShapeType = msoShapeOval Then shp.Line.ForeColor.RGB = RGB(0, 112, 192) shp.Line.Visible = msoTrue End If Next shp Selection.Collapse End Sub Here's the sample document for your testing: Sample Document.docx Expected Result.docx Would any of you be able to assist with rectifying this problem? I would greatly appreciate any help. Thank you in advance. |
#2
|
||||
|
||||
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 |
#3
|
|||
|
|||
Quote:
|
#4
|
||||
|
||||
You are right, getting the X position is confounded when the text is not simply left aligned. Your example document has justified text and the values calculated for the horizontal alignment positions are inaccurate. I also tried using the Selection object but wasn't getting predictable results there either.
Can I ask what is the point of sticking a circle around text? Wouldn't it be a whole lot easier to just apply highlight to that text?
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#5
|
|||
|
|||
Quote:
|
#6
|
||||
|
||||
Sounds like this macro is complying with the policy but absolutely not the intent of the rule #maliciouscompliance
I'm not going to fiddle with this further to see if I can figure out how to consistently deal with the location of the circle. Instead, I would explore a workaround of just using the vertical position and apply a consistent horizontal location for the circle (out in the margin area) so your officer can see all the circles down the edge of the page and choose to tick them off as a progress record during the meeting.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#7
|
|||
|
|||
Quote:
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Seeking Assistance with Word Macro to Add Transparent, Blue Line Circle Shape | syl3786 | Word VBA | 5 | 01-21-2024 03:41 AM |
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 |