Microsoft Word Macro Help- Inserting shape located on selected line

[Chris Macro]

Hi,

I have been doing alot of macros in excel and am now trying to venture into making a few in Word. I recorded a macro that creates a rectangle with no fill and a red border. For some reason the shape is only appearing near the top of my page (where I recorded inserting it) instead of the line I am on. Is there any way to make the shape appear on the line I am on? Thanks!

code:

Sub Highlight_Box()

    ActiveDocument.Shapes.AddShape(msoShapeRectangle, 90#, 183#, 69.75, _
        18#).Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Line.ForeColor.ObjectThemeColor = wdThemeColorAccent2
    Selection.ShapeRange.Line.ForeColor.TintAndShade = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.Weight = 2.25
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.Style = msoLineSingle
End Sub

 

[Macropod]

Try something along the lines of:

Sub Highlight_Box()
Dim Shp As Shape, sngTop As Single, sngLeft As Single, sngWdth As Single, sngHght As Single
With Selection.Characters
  sngHght = .First.Font.Size * 1.5
  sngTop = .First.Information(wdVerticalPositionRelativeToPage) - sngHght * 0.8
  sngLeft = .First.Information(wdHorizontalPositionRelativeToPage)
  sngWdth = .Last.Next.Information(wdHorizontalPositionRelativeToPage) - sngLeft
End With
Set Shp = ActiveDocument.Shapes.AddShape(Type:=msoShapeRectangle, Left:=sngLeft, Top:=sngTop, Width:=sngWdth, Height:=sngHght)
With Shp
  .Fill.Visible = msoFalse
  With .Line
    .ForeColor.ObjectThemeColor = wdThemeColorAccent2
    .ForeColor.TintAndShade = 0#
    .Visible = msoTrue
    .Weight = 2.25
    .Style = msoLineSingle
  End With
End With
End Sub

In general, the above should put a box around whatever you have selected. Do be aware that you don't really need a box for this - you could simply apply a border to the selected text.

 

[Chris Macro]

Thanks for your response Paul. I am getting an error (Object variable or With block variable not set) on the following line:

sngWdth = .Last.Next.Information(wdHorizontalPositionRelativeToPage) - sngLeft

Also, I did not really intend this macro to highlight words, as much as highlight screenshots for creating "Training Documents". My thought was I could click onto a line below a screenshot picture, run the macro to give me a highlight box on that line, and then I could drag the box onto the picture to wherever I wanted a highlight.

 

[Macropod]

The error was probably due to having nothing selected. Try:

Sub Highlight_Box()
Dim Shp As Shape, sngTop As Single, sngLeft As Single
With Selection.Characters
  sngTop = .First.Information(wdVerticalPositionRelativeToPage) - 12
  sngLeft = .First.Information(wdHorizontalPositionRelativeToPage)
End With
Set Shp = ActiveDocument.Shapes.AddShape(Type:=msoShapeRectangle, Left:=sngLeft, Top:=sngTop, Width:=72, Height:=18)
With Shp
  .Fill.Visible = msoFalse
  With .Line
    .ForeColor.ObjectThemeColor = wdThemeColorAccent2
    .ForeColor.TintAndShade = 0#
    .Visible = msoTrue
    .Weight = 2.25
    .Style = msoLineSingle
  End With
End With
End Sub

 

[Chris Macro]

That's the one I wanted! Thank you so much for your help!!