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.

CollapseHeadings.bas

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