Word VBA Insert Shape

Question

Hi, I have this code I'm using to create "rev bars" to the right of document text.  If the "rev bar" is for multiple lines of text, I highlight the text then execute the macro.  This works fine if the text is not in a table. Outside of a table, I can get a shape that can be the length of the page.   In a table, if I highlight lines of text that combined height is greater than 1.95", I get Run-time error 6:  Overflow.

Sub AddLandscapeRevisionBar()

Dim RevNumber As String

    Dim lineNew As Shape

    Dim TriangleNew As Shape

    Dim Deletable As Shape

    Dim NumberNew As Shape

    Dim oDoc As Word.Document

    Dim ThisRange As Range

    Dim RangeStart As Double

    Dim RangeEnd As Double

    Dim FirstLineNumber As Double

    Dim LineSpacing As Integer

    Dim FontSize As Integer

    Dim LastLineFont As Integer

    Dim FirstLineFont As Integer

    Dim LineLength As Integer

    Set oDoc = ActiveDocument

    Set ThisRange = Selection.Range

    Application.ScreenUpdating = False

    RangeStart = ThisRange.Information(wdVerticalPositionRelativeToPage)

    RangeEnd = ThisRange.Words.Last.Information(wdVerticalPositionRelativeToPage)

    FirstLineNumber = ThisRange.Information(wdFirstCharacterLineNumber)

    LineSpacing = ThisRange.ParagraphFormat.LineSpacing

    FontSize = ThisRange.Font.Size

    If RangeStart = RangeEnd Then 'One Line, format accordingly

        LineLength = FontSize * 1.3

        Set lineNew = ActiveDocument.Shapes.AddLine(745, RangeStart + FontSize / 4, 745, RangeStart + LineLength)

        lineNew.Line.ForeColor.RGB = vbBlack

    Else

        'MsgBox "Multiple Lines"

        LastLineFont = ThisRange.Words.Last.Font.Size

        FirstLineFont = ThisRange.Words.First.Font.Size

        LineLength = RangeEnd - RangeStart + (LastLineFont * 1.1)

        Set lineNew = ActiveDocument.Shapes.AddLine(745, RangeStart + FirstLineFont / 4, 745, RangeStart + LineLength)

        lineNew.Line.ForeColor.RGB = vbBlack

    End If

    lineNew.Name = "vline " & Rnd(99999)

    ThisRange.Select

    Application.ScreenUpdating = True

End Sub

thanks for any insight!

Cindy

Answer 1

Hi Cindy,

The error has nothing to do with the text being inside a table, or the amount of text that is selected.  It is caused by the text not being all of the same font size.

If you move the 

FontSize = ThisRange.Font.Size

so that it is inside the following If...End If construction

    If RangeStart = RangeEnd Then 'One Line, format accordingly

                  FontSize = ThisRange.Font.Size

You will not get the error unless you have a mixture of font sizes in the one line of text

Answer 2

I cannot replicate the issue here

Is there a Debug button in the error message?  If so and you click on it, what line of the code is highlighted?

Answer 3

Worked perfectly.  Thank you!

Cindy

Answer 4

Doug, it is highlighting on 

FontSize = ThisRange.Font.Size .

thanks

Cindy