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

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

0 голосов
/ 03 мая 2018

В MsWord, даже если последнее местоположение курсора сохраняется автоматически, что вы можете вызвать с помощью Shift + F5 при повторном открытии документа,
- Вы также не можете установить его в режиме Outline.
- Не используйте эту или любую другую закладку в свернутом виде Outline для перехода.
Места закладки для свернутого контура невидимы.
Ближайший вариант - открыть все уровни контура и перейти к закладке.
Для нескольких сотен страниц научных документов, которые мы используем ежедневно, это неприемлемо, потому что это сильно снижает удобство использования редактора структуры.
В настоящее время в веб-представлении также имеется складная система заголовков (где по иронии судьбы также правильно работает закладка), но в ней отсутствуют другие важные функции, которые есть в реальном представлении структуры.
Похоже, что двум командам подпроекта было трудно сотрудничать с командой разработчиков Office.
Я не нашел работающего решения в сети в течение нескольких дней, поэтому, наконец, я сел, чтобы найти надежно работающее решение (после уничтожения 3 тупиковых идей).
Я опубликую фрагменты кода VBA в ответе.

1 Ответ

0 голосов
/ 03 мая 2018

Для моего решения мне нужно было создать отдельную закладку для каждого уровня заголовка над местоположением курсора, чтобы иметь возможность открывать их один за другим при повторном открытии документа.
Примечание: у меня были некоторые проблемы с использованием 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
...