![]() |
#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] |
|
![]() |
||||
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 |
![]() |
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 |
![]() |
kcbenson | Word | 2 | 10-16-2014 01:31 PM |