A couple of years ago, I wrote this macro to help me switch effortlessly between Outline and Normal (Draft) layout. It works 99% of the time, but once in awhile it screws up.

One of the primary reasons I wrote the macro in the first place was to eliminate an annoying situation related to the use of Alt+Shift with the Up & Down arrows to move entire paragraphs. Prior to the macro, if I switched to Outline layout, set the outline level to 2, did some work, and then switched back to Draft layout without remembering to reset the outline level to "all", the next time I tried to move a paragraph, it would sometimes move an entire Level 2 section. The macro has mostly cured this little problem, but not always. I think the problem has to do with if I run the macro from a Level 2 heading to get to Outline layout and then forget to run it again from a heading of the same level, sometimes leaves the document in some sort of limbo state with regard to the outline level. For example, in a document with several levels of headings, if I run the macro from a Level 2 heading, it will switch to Outline layout and set Word to only show heading up to Level 2. If I run the macro again fro a Level 2 heading everything is fine. But if I run it from a higher level heading, it screws up. I cannot be 100% sure because I cannot reproduce the problem.

In the comments, I note that the macro sometimes causes the tab character to change the style to a Heading 4. But this hasn't happened in a long time.

Would anyone be willing to take a look a the code and suggest improvements? I based it on the commented code at the bottom generated by the recorder.

'=======================================================================================
'                        My Outline Level

' Toggle Normal and Outline Layout and Outline Level

'   Syntax: MyOutlineLevel (Assigned to keyboard shortcut Alt-o)

' Decision table:

'   Document        Paragraph
'   Layout        Outline Level   Action
'   ------------  -------------   ------
'   Normal,Print    Body text     Nothing
'   Normal,Print       nn         1. Switch document to Outline layout
'                                 2. Set paragraph to Outline level nn
'   Outline            xx         1. Set paragraph to Outline level All
'                                 2. Switch document to Normal layout

' To Do:

' Log:
' 01/17/14  Created
' 12/13/15  Sometimes, this macro will cause the tab key to change the style to
'           a heading4.
'=======================================================================================
Sub MyOutlineLevel()

'Call MsgBox("ActiveWindow.View = " & ActiveWindow.View & vbCrLf _
'            & "Selection.Paragraphs(1).OutlineLevel = " _
'            & Selection.Paragraphs(1).OutlineLevel)

Dim DocLayout   'The document layout (view)
Dim ParOutline  'The paragraph outline level (1-9 + 10 (=Bodytext))

'DocLayout = ActiveWindow.View.Type
DocLayout = ActiveWindow.View
ParOutline = Selection.Paragraphs(1).OutlineLevel

Select Case DocLayout                 'Check the layout (view)
  Case wdNormalView, wdPrintView        'If Normal or Page (print) view,
    If ParOutline = 10 Then               'If BodyText paragraph,
      Exit Sub                              'Do nothing
    Else                                  'Else, must be a heading
      ActiveWindow.View.ShowHeading ParOutline  'Show headings only up to that level
    End If
    ActiveWindow.View.Type = wdOutlineView      'And switch to Outline view
  Case wdOutlineView                    'If Outline view,
    ActiveWindow.View.ShowAllHeadings     'Show everything
    ActiveWindow.View.Type = wdNormalView 'And switch back to Normal view
  Case Else                             'For any other view,
    Exit Sub                              'NOP
End Select

'Call MsgBox("ActiveWindow.View = " & ActiveWindow.View & vbCrLf _
'            & "Selection.Paragraphs(1).OutlineLevel = " _
'            & Selection.Paragraphs(1).OutlineLevel)

'========== Macro Recording
'Sub TestOutlineLevel()
''
'' TestOutlineLevel Macro
''
''
'  ActiveWindow.ActivePane.View.Type = wdOutlineView
'  ActiveWindow.View.ShowHeading 1
'  ActiveWindow.View.ShowHeading 2
'  ActiveWindow.View.ShowHeading 9
'  ActiveWindow.View.ShowAllHeadings
'  If ActiveWindow.View.SplitSpecial = wdPaneNone Then
'    ActiveWindow.ActivePane.View.Type = wdNormalView
'  Else
'    ActiveWindow.View.Type = wdNormalView
'  End If
'End Sub

End Sub