'-------------------------------------------------------------
'  例句號碼重新編排 Renumber 1.33   (C) 2009-2012 T.Tanomura
'-------------------------------------------------------------

Sub Renumber()

  Dim fn, en, wn, m1, m2, m3, m4, m5, z, tr, m, d, p, n, u
  Dim map(999) As Integer

  fn = False  ' 處理腳注中的例句號碼(True)/不處理(False)
  en = False  ' 處理後注中的例句號碼(True)/不處理(False)
  wn = True   ' 警告例句號碼的重複(True)/不警告(False)

  m1 = "正在處理中..."
  m2 = "處理結束了."
  m3 = "有未定義例句號碼被參照."
  m4 = "有例句號碼重複."
  m5 = "警告"

  z = "★"

  Application.StatusBar = m1
  Application.ScreenUpdating = False
  tr = ActiveDocument.TrackRevisions
  ActiveDocument.TrackRevisions = False

  With ActiveDocument
    Erase map
    m = 0
    d = ""
    For Each p In .Paragraphs
      n = get_exnum(LTrimPlus(p.Range.Text))
      If 0 < n Then
        If map(n) = 0 Then
          m = m + 1
          map(n) = m
        Else
          If wn Then append_exnum d, map(n)
        End If
      End If
    Next

    u = ""
    rewrite_exnum .Range, map, z, u, m1
    If fn And 0 < .Footnotes.Count Then
      rewrite_exnum .Footnotes(1).Range, map, z, u, m1
    End If
    If en And 0 < .Endnotes.Count Then
      rewrite_exnum .Endnotes(1).Range, map, z, u, m1
    End If
  End With

  ActiveDocument.TrackRevisions = tr
  Application.ScreenUpdating = True
  Application.ScreenRefresh
  Application.StatusBar = m2

  report_errors u, d, m3, m4, m5

End Sub

Function get_exnum(p)
  Dim i
  get_exnum = 0
  If Left(p, 1) = "(" And Mid(p, 2, 1) <> "0" Then
    i = 0
    While is_a_digit(Mid(p, 2 + i, 1))
      i = i + 1
    Wend
    If 1 <= i And i <= 3 Then get_exnum = Val(Mid(p, 2, i))
  End If
End Function

Function is_a_digit(c)
  is_a_digit = "0" <= c And c <= "9"
End Function

Function LTrimPlus(p)
  LTrimPlus = LTrim(Replace(p, vbTab, " "))
End Function

Sub rewrite_exnum(r, map, z, u, m1)
  Dim ls, n
  r.SetRange 0, 0
  With r.Find
    ls = IIf(Application.International(wdListSeparator) = ";", ";", ",")
    .Text = "\([0-9]{1" + ls + "4}"
    .MatchWildcards = True
    While .Execute
      With .Parent
        n = Val(Mid(.Text, 2))
        If Mid(.Text, 2, 1) <> "0" And n < 1000 Then
          If n <> map(n) Then
            .SetRange .Start + 1, .End
            If 0 < map(n) Then
              .Text = CStr(map(n))
            Else
              .Text = z + CStr(n)
              append_exnum u, n
            End If
            .SetRange .End, .End
          End If
        End If
      End With
    Wend
  End With
End Sub

Sub append_exnum(ByRef s, n)
  If s <> "" Then s = s + ", "
  s = s + "(" + CStr(n) + ")"
End Sub

Sub report_errors(u, d, m3, m4, m5)
  Dim s, e
  s = "   "
  If u <> "" Then u = m3 + s + vbCr + u + s
  If d <> "" Then d = m4 + s + vbCr + d + s
  e = u + IIf(u <> "" And d <> "", vbCr + vbCr, "") + d
  If e <> "" Then MsgBox e, , "Renumber - " + m5
End Sub