需要捕获MS Word中的当前滚动位置(不是光标位置)

时间:2015-06-10 19:22:18

标签: vba ms-word word-vba

我需要在Word文档中获取当前滚动位置(我认为这是正确的术语;即,我的虚拟镜头指向文档的位置,而不是我的光标所在的位置),以便在运行宏时我最后可以回到那个位置。

我写了一个宏,它从当前光标位置向后搜索专利申请部件号,确定候选下一个可用部件号作为前一个最大值+ 1,然后搜索出现在光标下方的已排序数字列表,看是否候选零件编号与下一个使用过的编号碰撞,如果是,它会向候选项添加1并再次检查碰撞,直到找到最小的未使用整数,尽可能地遵循在零件中引入零件的惯例按部件号顺序描述。

然后它将该数字插入当前光标位置。它工作正常;然而,它将当前线移动到观察窗的顶部,这是令人迷惑的。我宁愿把卷轴保持在原位。这是我的代码:

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位数字有点过于包容,但就我的问题而言,我们不需要完整的正则表达式

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

1 个答案:

答案 0 :(得分:2)

要捕获窗口滚动位置,请使用:

scrollPosition = ActiveWindow.ActivePane.VerticalPercentScrolled

将其重新设置为原始用途:

ActiveWindow.ActivePane.VerticalPercentScrolled = scrollPosition