title: Need to capture current scroll position (not cursor position) in MS Word
body: <p>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.  </p>
  
  <p>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.                                         </p>
  
  <p>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:</p>
  
  <pre><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)"
  </code></pre>
  
  <p>' 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</p>
  
  <pre><code>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) &gt; 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) &gt; 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 &lt; 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 &amp; " ")
  Selection.MoveRight
  
  End Sub
  </code></pre>