![]() |
|
#2
|
||||
|
||||
|
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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| Macro to convert word document in individual JPGs | staicumihai | Word VBA | 3 | 02-07-2019 03:45 AM |
| Convert Word 2007 macro to work in Word 2003 | Kamaflage | Word VBA | 1 | 02-25-2015 11:40 PM |
Macro to convert word file into pdf
|
cc9083 | Word VBA | 2 | 02-23-2015 01:22 AM |
| Convert manual cross references in footnotes to other footnotes to automatic cross references | ghumdinger | Word VBA | 7 | 11-20-2014 11:47 PM |
Regular (roman) character style doesn't change text to roman
|
kcbenson | Word | 2 | 10-16-2014 01:31 PM |