Microsoft Office Forums - View Single Post - [Solved] Word Macro to convert Roman references

macropod · 01-08-2021, 04:52 AM

If the numbering system employs of Word's automatic numbering, it's a simple matter to change the number format. No code required. Otherwise, try:

Code:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[A-Z][a-z]{1,3}. [iIvVxXlLmMcCdD]{1,}. [0-9]."
    .Replacement.Text = ""
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    .Text = Split(.Text, ".")(0) & ". " & _
        Roman2Num(Trim(Split(.Text, ".")(1))) & _
        ":" & Trim(Split(.Text, ".")(2))
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub

Function Roman2Num(Roman As String) As Long
Dim Roman2 As String, Char1 As String, Char2 As String
Dim Number As Long
Roman2 = UCase(Roman)
Do While Len(Roman2)
  Char1 = Left(Roman2, 1)
  Char2 = Mid(Roman2, 2, 1)
  Roman2 = Right(Roman2, Len(Roman2) - 1)
  Select Case Char1
    Case "M"
      Number = Number + 1000
    Case "D"
      Number = Number + 500
    Case "C"
      Select Case Char2
        Case "M"
          Number = Number + 900
          Roman2 = Right(Roman2, Len(Roman2) - 1)
        Case "D"
          Number = Number + 400
          Roman2 = Right(Roman2, Len(Roman2) - 1)
        Case Else
          Number = Number + 100
      End Select
    Case "L"
      Number = Number + 50
    Case "X"
      Select Case Char2
        Case "M"
          Number = Number + 990
          Roman2 = Right(Roman2, Len(Roman2) - 1)
        Case "D"
          Number = Number + 490
          Roman2 = Right(Roman2, Len(Roman2) - 1)
        Case "C"
          Number = Number + 90
          Roman2 = Right(Roman2, Len(Roman2) - 1)
        Case "L"
          Number = Number + 40
          Roman2 = Right(Roman2, Len(Roman2) - 1)
        Case Else
          Number = Number + 10
      End Select
    Case "V"
      Number = Number + 5
    Case "I"
      Select Case Char2
        Case "M"
          Number = Number + 999
          Roman2 = Right(Roman2, Len(Roman2) - 1)
        Case "D"
          Number = Number + 499
          Roman2 = Right(Roman2, Len(Roman2) - 1)
        Case "C"
          Number = Number + 99
          Roman2 = Right(Roman2, Len(Roman2) - 1)
        Case "L"
          Number = Number + 49
          Roman2 = Right(Roman2, Len(Roman2) - 1)
        Case "X"
          Number = Number + 9
          Roman2 = Right(Roman2, Len(Roman2) - 1)
        Case "V"
          Number = Number + 4
          Roman2 = Right(Roman2, Len(Roman2) - 1)
        Case Else
          Number = Number + 1
      End Select
  End Select
Loop
Roman2Num = Number
End Function