Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Simple VBA script that I use in Mac Word for collapsing Up headings in Outline View; it works for me, but I've had it floating around for so long, I barely remember how it works.
Sub CollapseHeadings()
' Use this code at your own risk
' It works for me. I use it in Word documents while in Outline View
' for documents set up with Outline View in mind
' Remember Ctrl + Pause Break will get break the program
On Error GoTo ErrorHandler
Dim r As Range, o As Integer, p As Long, f As Boolean
Dim currentOutlineLevel, nextOutlineLevel
Dim timeout As Integer ' used to pre
f = False
timeout = 0
Set r = Selection.Range
r.End = r.Start + 1 'reduce selection to a single character
currentOutlineLevel = r.ParagraphFormat.OutlineLevel
Selection.MoveDown Unit:=wdParagraph, Count:=1
nextOutlineLevel = Selection.Range.ParagraphFormat.OutlineLevel
Selection.MoveUp Unit:=wdParagraph, Count:=1
If nextOutlineLevel > currentOutlineLevel Then
With ActiveWindow
.Activate
.View.Type = wdOutlineView
With .View
.CollapseOutline
.CollapseOutline
.CollapseOutline
.CollapseOutline
.CollapseOutline
End With
End With
Else
If currentOutlineLevel > 1 Then
Do Until f = True Or timeout > 1000
Selection.MoveUp Unit:=wdParagraph, Count:=1
If Selection.ParagraphFormat.OutlineLevel < currentOutlineLevel Then
f = True
End If
timeout = timeout + 1
Loop
End If
With ActiveWindow
.Activate
.View.Type = wdOutlineView
With .View
.CollapseOutline
.CollapseOutline
.CollapseOutline
.CollapseOutline
.CollapseOutline
End With
End With
End If
Exit Sub
ErrorHandler:
'on error just end
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.