檢查註釋編號

                  Sub 檢查註釋編號()
Dim r As Range, a, flg As Boolean
On Error Resume Next
For Each a In ThisDocument.Characters
    If a.Font.ColorIndex = 0 And StrComp(a, Chr(19)) = 0 Then
        a.Select
        n = 0
        n1 = 0
'        Stop
    End If
    If a.Font.ColorIndex = 6 Then 'wdRed
        a.Select
        If Selection.End > 26882 Then
            If Len(Selection) >= 16 And flg = False Then
                n = Replace(Replace(Mid(Selection, InStr(Selection, "○,") + 2), ")", ""), Chr(21), "")
                flg = True

                ed = Selection.End
                'Selection.Collapse wdCollapseEnd
            ElseIf Len(Selection) >= 16 And flg Then
                If Selection.End > ed And ed <> Empty Then
                    n1 = Replace(Replace(Mid(Selection, InStr(Selection, "○,") + 2), ")", ""), Chr(21), "")
                    If n1 - n <> 1 Then 'And n1 - n <> 0 Then
                        If a.Previous.Previous <> Chr(-24235) Then
                            Beep
                            Stop
                        End If
                    End If
                    flg = False
                End If
            End If
    '        Selection.MoveEndWhile "}"
    '        do while
        End If
    End If
Next a
'Selection.Find.Execute "eq \o\ac(○," & i & ")"
'
'Selection.SetRange InStr(ThisDocument.Range, "eq \o\ac(○,1)"), InStr(ThisDocument.Range, "eq \o\ac(○,1)") + 16
'r.Select
MsgBox "done!", vbInformation
End Sub