Sub ReLinkFootNotes()
    Dim i As Integer, j As Integer, k As Integer, l As Integer, FtRng As Range
    Application.ScreenUpdating = False
    With ActiveDocument
        Set FtRng = Selection.Range
        With FtRng
            .Style = "Note de bas de page"
            With .Find
                .ClearFormatting
                .Replacement.ClearFormatting
                 ' Change '[' and ']' on the next line to whatever is appropriate if the selected
                 ' footnotes' numbers are enclosed in characters other than square brackets
                .Text = "([0-9]{1;})"
                .Replacement.Text = "\1"
                .Forward = True
                .Wrap = wdFindStop
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchAllWordForms = False
                .MatchSoundsLike = False
                .MatchWildcards = True
                .Execute Replace:=wdReplaceAll
            End With
            k = .Paragraphs(1).Range.Words(1) - 1
            j = k
            l = ActiveDocument.Footnotes.Count - k
            For i = 1 To .Paragraphs.Count
                If .Paragraphs(i).Range.Words(1) = j + 1 Then
                    j = j + 1
                End If
            Next i
        End With
        For i = k + 1 To j
            StatusBar = "Finding Footnote Location: " & i + l
            With .Content.Find
                 ' Change '"[" & i & "]"' string on the next line to whatever is appropriate
                 ' if the in-line references are not enclosed in square brackets
                .Text = i
                 ' Delete/comment out the next line if not applicable
                .Font.Superscript = True
                .MatchWholeWord = True
                .MatchWildcards = False
                .Execute
                If .Found = True Then
                    .Parent.Select
                    With Selection
                        .Delete
                        .Footnotes.Add Range:=Selection.Range, Text:=""
                    End With
                End If
            End With
        Next i
        With FtRng
            For i = k + 1 To j
                StatusBar = "Transferring Footnote: " & i + l
                With .Paragraphs(1).Range
                    .Cut
                    With ActiveDocument.Footnotes(i + l).Range
                        .Paste
                        .Words(1).Delete
                        .Characters.Last.Delete
                    End With
                End With
            Next i
            On Error Resume Next
        End With
        Set FtRng = Nothing
    End With
    Application.ScreenUpdating = True
End Sub