字 |VBA - 如何在大纲视图中启动Word - 准确地从您离开的地方打开?

Question

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

Answer 1

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

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