字| VBA - 如何在“大纲”视图中启动Word - 从中​​断的位置打开？

Question

在MsWord中，即使光标的最后一个位置是自动保存的，您可以在重新打开文档时按Shift + F5调用， - 您既不能将其设置为在“大纲”视图中启动。
- 不要在折叠的“大纲”视图上使用该标签或任何其他书签来跳转 折叠轮廓的书签位置是不可见的 可以实现的最接近的选项是打开轮廓的所有级别，然后跳转到书签。
对于我们每天使用的几百页科学文档是不可接受的，因为它大大降低了Outline编辑器的可用性。
Web-view现在也有一个可折叠的标题系统（具有讽刺意味的是书签goto也能正常工作），但缺少真正的Outline视图所具有的其他重要功能。
似乎两个子项目团队很难在Office开发团队中进行协作 我好几天都没有在网上找到一个可行的解决方案，所以最后我坐下来提出了一个可靠的解决方案（在删除了3个死胡同之后）。 我将在响应中发布VBA代码片段。

Answer 1

对于我的解决方案，我必须为光标位置上方的每个标题级别创建一个单独的书签，以便在重新打开文档时逐个打开它们。 注意：我在使用range.goto时遇到了一些问题，所以我现在必须坚持操作Selection 有两个部分 - 一个用于保存位置和关闭文档，另一个用于正确打开它。 - 最好将它们放在Normal.dot模块中。
DocumentClosing宏：

Sub SaveAndClose()
    Application.ScreenUpdating = False
        Call IttTartok
        ActiveDocument.Close savechanges:=True
    Application.ScreenUpdating = True
End Sub
Private Sub IttTartok()
    Application.ScreenUpdating = False
    Dim Level As Variant
    Dim InduloSel As Range, KereSel As Range
    Dim myLevel As Long

'Delete all aiding bookmarks from the last save cycle.
    If ActiveDocument.Bookmarks.Exists("IttL1") = True Then ActiveDocument.Bookmarks("IttL1").Delete
    If ActiveDocument.Bookmarks.Exists("IttL2") = True Then ActiveDocument.Bookmarks("IttL2").Delete
    If ActiveDocument.Bookmarks.Exists("IttL3") = True Then ActiveDocument.Bookmarks("IttL3").Delete
    If ActiveDocument.Bookmarks.Exists("IttL4") = True Then ActiveDocument.Bookmarks("IttL4").Delete
    If ActiveDocument.Bookmarks.Exists("IttL5") = True Then ActiveDocument.Bookmarks("IttL5").Delete
    If ActiveDocument.Bookmarks.Exists("IttL6") = True Then ActiveDocument.Bookmarks("IttL6").Delete
    If ActiveDocument.Bookmarks.Exists("IttL7") = True Then ActiveDocument.Bookmarks("IttL7").Delete
    If ActiveDocument.Bookmarks.Exists("IttL8") = True Then ActiveDocument.Bookmarks("IttL8").Delete
    If ActiveDocument.Bookmarks.Exists("IttL9") = True Then ActiveDocument.Bookmarks("IttL9").Delete
    If ActiveDocument.Bookmarks.Exists("IttLAll") = True Then ActiveDocument.Bookmarks("IttLAll").Delete
'Save the cursor location in a Bookmark and check if it is a heading or Bodytext
    ActiveDocument.Bookmarks.Add Range:=selection.Range, Name:="IttLAll"
    myLevel = selection.Paragraphs(1).OutlineLevel
    If myLevel = 10 Then
        selection.GoTo wdGoToHeading, wdGoToPrevious, 1
        myLevel = selection.Paragraphs(1).OutlineLevel
        ActiveDocument.Bookmarks.Add Range:=selection.Range, Name:="IttL" & myLevel
    End If
'Search for the upline headings of the original cursor location
        For Level = myLevel - 1 To 1 Step -1
                selection.Find.ClearFormatting
                selection.Find.Style = ActiveDocument.Styles(((-(Level + 1))))
                With selection.Find
                    .Text = ""
                    .Replacement.Text = ""
                    .Forward = False
                    .Wrap = wdFindContinue
                    .Format = True
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False

                    .Execute
                End With
'...and save the location of every upline heading in a separate Bookmark
                If selection.Find.Found Then
                     ActiveDocument.Bookmarks.Add Range:=selection.Range, Name:="IttL" & Level
                End If
        Next
    Application.ScreenUpdating = True
End Sub

...和开启者宏：
（注意：保留名称，这是启动新文档时自动撤离所需的名称。）

Sub AutoOpen()
    Application.ScreenUpdating = False
        ActiveWindow.View = wdOutlineView
        ActiveWindow.View.ShowHeading 1
        Call WhereILeftOff
    End If
    Application.ScreenUpdating = True
End Sub

Private Sub WhereILeftOff()
Dim i As Variant
If ActiveDocument.Bookmarks.Exists("IttLAll") = True Then
    For i = 1 To 9
        If ActiveDocument.Bookmarks.Exists("IttL" & i) = True Then
            ActiveWindow.View.ExpandOutline ActiveDocument.Bookmarks("IttL" & i).Range
        Else
            selection.GoTo wdGoToBookmark, , , "IttLAll"
            selection.EndKey Unit:=wdLine, Extend:=wdMove
            Exit For
        End If
    Next
End If
End Sub