Question

我遇到了麻烦。使用Microsoft Word 2013，在导航面板中，当您单击超链接时，Word将转到该链接并将其设置在“页面屏幕视图”的顶部。我想用VBA做到这一点。我有一个有效的代码，除了它没有在顶部完全设置所需的超链接。

我的代码是：

Sub NextPoint(control As IRibbonControl)
Application.ScreenUpdating = False
Do
   Selection.Next(Unit:=wdParagraph, Count:=1).Select
Loop Until Selection.Paragraphs.Style = "Título 3"
ActiveWindow.ScrollIntoView Selection.Range, True
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Application.ScreenUpdating = True
End Sub

Answer 1

使用VBA将文本放在屏幕顶部可能具有挑战性。但是，通过使用SmallScrolls进行迭代，您可以获得公平的解决方案。因此，您将获得窗口中的文本位置并滚动，直到它更接近您想要的位置。

我会使用以下调用ScrollIntoView

替换您的SelectionToTop()

Sub SelectionToTop()
    Dim pLeft As Long
    Dim pTop As Long, loopTop As Long, windowTop As Long
    Dim pWidth As Long
    Dim pHeight As Long, windowHeight As Long
    Dim Direction As Integer

    windowHeight = PixelsToPoints(ActiveWindow.Height, True)
    ActiveWindow.GetPoint pLeft, windowTop, pWidth, pHeight, ActiveWindow
    ActiveWindow.GetPoint pLeft, pTop, pWidth, pHeight, Selection.Range

    'Direction, defines scroll direction -1 0 or 1
    Direction = Sgn((pTop + pHeight / 2) - (windowTop + pHeight))
    Do While Sgn((pTop + pHeight / 2) - (windowTop + pHeight)) = Direction And (loopTop <> pTop)
      ActiveWindow.SmallScroll Direction
      loopTop = pTop
      ActiveWindow.GetPoint pLeft, pTop, pWidth, pHeight, Selection.Range
    Loop
End Sub

您还可以尝试将公式中的文字居中，只需对(windowTop + pHeight)到(windowTop + windowHeight / 2)的公式进行少量更改，如下所示

Sub SelectionToCenter()
    Dim pLeft As Long
    Dim pTop As Long, loopTop As Long, windowTop As Long
    Dim pWidth As Long
    Dim pHeight As Long, windowHeight As Long
    Dim Direction As Integer

    windowHeight = PixelsToPoints(ActiveWindow.Height, True)
    ActiveWindow.GetPoint pLeft, windowTop, pWidth, pHeight, ActiveWindow
    ActiveWindow.GetPoint pLeft, pTop, pWidth, pHeight, Selection.Range

    'Direction, defines scroll direction -1 0 or 1
    Direction = Sgn((pTop + pHeight / 2) - (windowTop + windowHeight / 2))
    Do While Sgn((pTop + pHeight / 2) - (windowTop + windowHeight / 2)) = Direction And (loopTop <> pTop)
      ActiveWindow.SmallScroll Direction
      loopTop = pTop
      ActiveWindow.GetPoint pLeft, pTop, pWidth, pHeight, Selection.Range
    Loop
End Sub

Answer 2

借助StackOverflow的这些英雄的帮助，我现在拥有一个完美模拟Microsoft Word导航面板的代码，至少使用我的19英寸显示器。这是代码，我希望它可以帮助其他人：

Sub NextPoint(control As IRibbonControl)
  Application.ScreenUpdating = False
  Do
    Selection.Next(Unit:=wdParagraph, Count:=1).Select
  Loop Until Selection.Paragraphs.Style = "Heading 3"
  ActiveWindow.VerticalPercentScrolled = 100
  ActiveWindow.ScrollIntoView Selection.Range, True
  ActiveDocument.ActiveWindow.SmallScroll Down:=6
  Selection.MoveLeft Unit:=wdCharacter, Count:=1
  Application.ScreenUpdating = True
End Sub

使用VBA模拟导航面板“GoTo”

2 个答案: