suppress all duplicated paragraphs (to be used, for example, for a sorted extraction of identifiers)
Sub suppressDuplicates()
    Dim par As Paragraph
    Dim str1, str2 As String

    str1 = ""
    For Each par In ActiveDocument.Paragraphs
        str2 = par.range.text
        If (str1 = str2) Then
            par.range.text = ""
        Else
            str1 = str2
        End If
    Next par
End Sub

extract all the occurrences of "[…]" and put them into a new document
Sub extract()
    Dim actDoc, newDoc As Document
    Set actDoc = ActiveDocument
    Set newDoc = Documents.Add

    With actDoc.Content.Find
        .ClearFormatting
        .text = "\[*\]"
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Execute
        Do While .Found = True
            Dim str As String
            str = actDoc.range(.Parent.Start, .Parent.End).text
            newDoc.Content.InsertAfter (str)
            newDoc.Content.InsertParagraphAfter
            .Parent.Start = .Parent.End
            .Execute
        Loop
    End With
End Sub

select all the texts of style foobar
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("foobar")
With Selection.Find
    .text = ""
    .Replacement.text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute
WordBasic.SelectSimilarFormatting

retrieve the reference of a document in the headers
Dim sect As Section
Dim n As Integer
Dim str As String
…
Documents.Open FileName:=file1.Path, ReadOnly:=True
Set actDoc = ActiveDocument
For Each sect In actDoc.Sections
    If (sect.Headers(wdHeaderFooterPrimary).range.Tables.Count >= 1) Then
        n = sect.Headers(wdHeaderFooterPrimary).range.Tables(1).Columns.Count
        str = sect.Headers(wdHeaderFooterPrimary).range.Tables(1).Cell(1, n).range.text
        …
    End If
Next sect
actDoc.Close (wdDoNotSaveChanges)

hyperlink the JIRA references
Sub hyperlinkJIRA()
    With ActiveDocument.Content.Find
        .ClearFormatting
        .text = "[DPSV][EIMU][MPR]-[0-9]{1;4}"
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Execute
        Do While .Found = True
            Dim str As String
            str = ActiveDocument.range(.Parent.Start, .Parent.End).text
            ActiveDocument.Hyperlinks.Add Anchor:=ActiveDocument.range(.Parent.Start, .Parent.End), _
                Address:="https://jira.kikamedical.net/browse/" & str
            .Parent.Start = .Parent.End
            .Execute
        Loop
    End With
End Sub

hyperlink the document references
Sub hyperlinkDocs()
    Dim str As String
    With ActiveDocument.Content.Find
        .ClearFormatting
        .text = "K[0-9]{5}"
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Execute
        Do While .Found = True
            str = ActiveDocument.range(.Parent.Start, .Parent.End).text
            ActiveDocument.Hyperlinks.Add Anchor:=ActiveDocument.range(.Parent.Start, .Parent.End), _
                Address:="http://srvuranus/K3DocArchive/" & str
            .Parent.Start = .Parent.End
            .Execute
        Loop
    End With
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Text = "D[0-9]{4}"
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Execute
        Do While .Found = True
            str = ActiveDocument.Range(.Parent.Start, .Parent.End).Text
            ActiveDocument.Hyperlinks.Add Anchor:=ActiveDocument.Range(.Parent.Start, .Parent.End), _
                Address:="http://srvuranus/DIPDocArchive/" & str
            .Parent.Start = .Parent.End
            .Execute
        Loop
    End With
End Sub

check that the paragraphs are correctly outlined (e.g. that there is not a title 3 just after a title 1)
the bad paragraphs are listed in a new document
Sub CheckOutline()

    Dim p As Paragraph
    Dim lastLevel As Integer
    Dim actdoc, newDoc As Document

    Set actdoc = ActiveDocument
    Set newDoc = Documents.Add

    For Each p In actdoc.Paragraphs
        If (p.OutlineLevel <> wdOutlineLevelBodyText) Then
            If ((p.OutlineLevel - lastLevel) > 1) Then
                newDoc.Content.InsertAfter p.range.ListFormat.ListString & " " & p.range.text
                newDoc.Content.InsertParagraphAfter
            End If
            lastLevel = p.OutlineLevel
        End If
    Next p

End Sub

highlight in turquoise all the bookmarks which point toward a stricken through text
do no run this macro on the real document: in order to perform its tasks, it modifies the bookmarks
run this macro on a throwable copy of the document
Sub findObsoleteBookmark()

    Dim f As Field
    For Each f In ActiveDocument.Fields
        If (f.Type = wdFieldRef) Then
            Dim oldStrikeThough As Boolean
            oldStrikeThough = f.Result.Font.StrikeThrough
            Dim rg As range
            Set rg = f.Code
            rg.Text = Replace(rg.Text, "\* MERGEFORMAT", "")
            f.Update
            If (Not oldStrikeThough And f.Result.Font.StrikeThrough) Then
                f.Result.HighlightColorIndex = wdTurquoise
            End If
        End If
    Next f

End Sub

find all the sea green texts and set them to the automatic color
With ActiveDocument.Content.Find
    .ClearFormatting
    .Font.color = wdColorSeaGreen
    .Text = ""
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .Execute
    Do While ((.Found = True) And (.Parent.End > .Parent.Start))
        ' Word is doing something strange when there is no more matching: it still returns
        ' Found = True, but with .Parent.Start = .Parent.End = character after the last match
        If ((ActiveDocument.range(.Parent.End + 1, .Parent.End + 2).Text = vbCr & Chr(7)) And _
            (ActiveDocument.range(.Parent.End + 1, .Parent.End + 2).Font.color = wdColorSeaGreen)) Then
            ' include end of table cell marker if necessary
            .Parent.End = .Parent.End + 2
        End If
        ActiveDocument.range(.Parent.Start, .Parent.End).Font.color = wdColorAutomatic
        .Parent.Start = .Parent.End
        .Execute
    Loop
End With