Слово | VBA - Как запустить Word в режиме Outline - открывается именно там, где вы остановились?

Question

В MsWord, несмотря на то, что последнее местоположение курсора сохраняется автоматически, вы можете вспомнить Shift+F5 при повторном открытии документа,
- Вы также не можете установить его для запуска в режиме Outline.
- Не используйте эту или любую другую закладку в свернутом виде 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

... и макрос Opener:
(примечание: сохраните имя, необходимое для автоматического удаления при запуске нового документа.)

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