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