'---------------------------------------------------------------
'  예문 번호의 재정렬 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