Getting accurate Word line number with VBA

Hi harrylmh ... this was interesting...here's what I have to offer ...

first the bad news....this does not use the ctrl + g for go to, but rather a dropdown menu item when you right click in the document area.

next... a routine which will determine the page and linecounts for the document, and then determine where to go

Put this in the document open sub of your document. This will update word's dropdown menus.

Private Sub Document_Open()

    Dim stritem As String, strCaption As String
    Dim cbar As CommandBar
    Dim cbc As CommandBarControl
    Dim i As Integer, iCTlCount As Integer
 
    For Each cbar In Application.CommandBars
   
        iCTlCount = cbar.Controls.Count
        For i = 1 To iCTlCount
            If cbar.Controls(i).Caption Like "Bullets and*" Then
                For Each cbc In cbar.Controls
                    If cbc.Caption = "Go To Absolute Line Number" Then
                        Exit Sub
                    End If
                Next cbc
               
                With cbar.Controls.Add(msoControlButton)
                     .Caption = "Go To Absolute Line Number"
                     .OnAction = "GoToAbsoluteLine"
                     .Style = msoButtonIconAndCaption
                     .BeginGroup = True
                     .FaceId = 361
                     .TooltipText = "Go to absolute line number in the current document"
                     .Tag = .Caption
                     .Visible = True
                End With
            End If
       
        Next i
   
    Next cbar


End Sub


Next....

Using the VB editor,Add a module to the document, and add this in.

Sub GotoAbsoluteLine()

    Dim iPage As Integer
    Dim iLines As Integer
    Dim iAbsLine As Integer
    Dim iPageLines() As Integer
    Dim iPageCount As Integer
    Dim strPageNum As String
    Dim iGoToLine As Integer
   
    strline = InputBox("Enter aboslute line number", "Go To Document Line Number", 1)
       
    If Len(strline) > 0 Then
        If IsNumeric(strline) Then
            iAbsLine = Val(strline)
        Else
            MsgBox "Please enter numeric line value"
            Exit Sub
        End If
       
    Else
        MsgBox "Go To Absolute Line was cancelled"
        Exit Sub
    End If
   
    Application.ScreenUpdating = False
    ReDim iPageLines(Selection.Information(wdNumberOfPagesInDocument))
    strPageNum = Trim(Str(Selection.Information(wdNumberOfPagesInDocument)))
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=strPageNum
   
    'get last line of last page
   
    Selection.EndKey Unit:=wdStory
    iPageLines(Selection.Information(wdNumberOfPagesInDocument) - 1) = Selection.Information(wdFirstCharacterLineNumber)
    p = Selection.Information(wdNumberOfPagesInDocument)
    strPageNum = Trim(Str(p))
   
    For p = Selection.Information(wdNumberOfPagesInDocument) To 1 Step -1
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToPrevious, Count:=1, Name:=strPageNum
        Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=1, Name:=""
        iPageLines(p - 1) = Selection.Information(wdFirstCharacterLineNumber)
        strPageNum = Trim(Str(p))
    Next p
   
    For p = 0 To UBound(iPageLines) - 1
        iLines = iLines + iPageLines(p)
        If iLines > iAbsLine Then
            If p = 0 Then
                strPageNum = Trim(Str(p + 1))
                Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=strPageNum
                iGoToLine = iAbsLine - 1
                Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, _
                        Count:=iGoToLine, Name:=""
            Else
                strPageNum = Trim(Str(p + 1))
                Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=strPageNum
                iGoToLine = iAbsLine - (iLines - iPageLines(p)) - 1
                Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, _
                        Count:=iGoToLine, Name:=""
            End If
            Exit For
        End If
       
    Next p
   
    Application.ScreenUpdating = True


End Sub

Hi harrylmh,
This old question (QID 20558290) needs to be finalized -- accept an answer, split points, or get a refund.  Please see http://www.cityofangels.com/Experts/Closing.htm for information and options.

This question has been classified as abandoned.  I will make a recommendation to the moderators on its resolution in a week or two.  I would appreciate any comments by the experts that would help me in making a recommendation.
It is assumed that any participant not responding to this request is no longer interested in its final deposition.

If the asker does not know how to close the question, the options are here:
https://www.experts-exchange.com/help/closing.jsp

GPrentice00
Cleanup Volunteer