vbams-wordbookmarksoutline-view

Word | VBA - How to start Word in Outline view - opened exactly where you left off?


In MsWord, even though the last location of the cursor is saved automatically, that you could recall by Shift+F5 upon re-opening a document,
- You can neither set it to start in Outline view.
- Nor use that or any other bookmark on a collapsed Outline view to jump on.
Bookmark locations for a collapsed outline are invisible.
The closest option one can achieve is to open all levels of the outline and Then jump on the bookmark.
For the several hundred page scientific documents we use daily that is not acceptable, becuse it heavily decreases the usability of the Outline editor.
Web-view has nowdays also a collapsable Heading-system (where ironically also the bookmark goto works properly), but that lacks other important features that the real Outline view has.
It seems as if two sub-project teams had a hard time collaborating in the Office development team.
I haven't found a working solution on the net for days, so finally I sat down to come up with a reliably working solution (after trashing 3 dead-end ideas).
I will post the VBA code snippets in the response.


Solution

  • For my solution I had to create a separate bookmark for each heading level above cursor location, to be able to open them one by one when the document is re-opened.
    Note: I had some issues using range.goto, so instead I had to stick with manipulating Selection for now.
    There are two sections - one is for saving the location and closing the document, the other is for opening it properly. - Best to place them inside Normal.dot modules.
    the DocumentClosing macro:

    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
    

    ...and the Opener macro:
    (note: keep the name, that is needed for auto exacution upon starting of new doc.)

    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