Need to capture current scroll position (not cursor position) in MS Word

Question

I need to get the current scroll position (I think that is the right term; i.e., where is my virtual lens pointed at the document, not where my cursor is) in a Word document, so that when I run a macro I can return to that position at the end.

I wrote a macro that searches backward from the current cursor position for patent application part numbers, determines a candidate next available part number as the previous max + 1, then searches a sorted list of numbers appearing below the cursor to see if the candidate part number collides with the next used number, and if it does, it adds 1 to the candidate and checks for a collision again, until it finds the smallest unused integer, to follow as closely as possible the convention of introducing parts in the body of the description sequentially by part number.

Then it inserts that number at the current cursor position. It works fine; however, it moves the current line to the top of the viewing window, which is disorienting. I would rather keep the scroll where it is. Here is my code:

Sub InsertLocalNextPartNum()

Application.ScreenUpdating = False

Dim re As VBScript_RegExp_55.RegExp
Set re = New VBScript_RegExp_55.RegExp


re.pattern = "\b(\d{2,3}\b)"

' 2-3 digit numbers are a bit over-inclusive for a part number, but for purposes of my question we don't need the full regular expression

re.IgnoreCase = False
re.Global = True

Dim txt As String
Dim allLongMatches As MatchCollection, m As Match
Dim nums() As Long
Dim numsColl As New Collection
Dim maxNum As Long
maxNum = 0
Dim nextPartNum As String
Dim localNextPartNum As String
localNextPartNum = 0
Dim i As Long
Dim j As Long
Dim k As Long


Selection.HomeKey Unit:=wdStory, Extend:=wdExtend

txt = Selection.Range.text

If re.Test(txt) Then
        Set allLongMatches = re.Execute(txt)
         For Each m In allLongMatches

         numsColl.Add (m.Value)

         Next m
End If
ReDim nums(1 To numsColl.Count)

For i = 1 To numsColl.Count
    nums(i) = numsColl(i)
    If nums(i) > maxNum Then maxNum = nums(i)
Next i

localNextPartNum = maxNum + 1


Selection.MoveRight
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
txt = Selection.text

If re.Test(txt) Then
        Set allLongMatches = re.Execute(txt)
        For Each m In allLongMatches
         numsColl.Add (m.Value)
        Next m
End If

ReDim nums(1 To numsColl.Count)
Dim numTemp As String
Dim lngMin As Long
Dim lngMax As Long
lngMin = LBound(nums())
lngMax = UBound(nums())

For i = 1 To numsColl.Count
    nums(i) = numsColl(i)
Next i

For j = lngMin To lngMax - 1
    For k = j + 1 To lngMax
      If nums(j) > nums(k) Then
        numTemp = nums(j)
        nums(j) = nums(k)
        nums(k) = numTemp
      End If
    Next k
Next j

For i = 1 To numsColl.Count
    If localNextPartNum < nums(i) Then Exit For
   ' Debug.Print nums(i)
    If localNextPartNum = nums(i) Then localNextPartNum = nums(i) + 1
Next i
Selection.MoveLeft
Selection.InsertAfter (localNextPartNum & " ")
Selection.MoveRight

End Sub

Answer 1

To capture the window scroll position use:

scrollPosition = ActiveWindow.ActivePane.VerticalPercentScrolled

To set it back to the original use:

ActiveWindow.ActivePane.VerticalPercentScrolled = scrollPosition