Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 01-08-2021, 04:11 AM
WJSwanepoel WJSwanepoel is offline Word Macro to convert Roman references Windows 10 Word Macro to convert Roman references Office 2007
Advanced Beginner
Word Macro to convert Roman references
 
Join Date: Dec 2019
Location: Krugersdorp, South Africa
Posts: 38
WJSwanepoel is on a distinguished road
Question Word Macro to convert Roman references

I have a huge Word document with lots of Roman references. They typically look like this:

Xxxx. n. m.

Where n is a Roman number and m is an Arabic number. The Xxxx is 2 tot 4 Alphabetic characters (which must appear in a list of valid abbreviations).

It then needs to be converted to read:

Xxxx. n:m, but where n and m are now both Arabic numbers.

Eg. Hand. vii. 11 must be converted to Hand. 7:11

Can someone perhaps help to get me started on it? I am rather new to MS Macros.



Warm Regards,
Willem
Reply With Quote
  #2  
Old 01-08-2021, 04:52 AM
macropod's Avatar
macropod macropod is offline Word Macro to convert Roman references Windows 10 Word Macro to convert Roman references Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,225
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

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]
Reply With Quote
  #3  
Old 01-08-2021, 05:11 AM
WJSwanepoel WJSwanepoel is offline Word Macro to convert Roman references Windows 10 Word Macro to convert Roman references Office 2007
Advanced Beginner
Word Macro to convert Roman references
 
Join Date: Dec 2019
Location: Krugersdorp, South Africa
Posts: 38
WJSwanepoel is on a distinguished road
Default

Thank you very much Paul. I am almost there. All that remains is that Xxxx. must appear is a list of valid abbreviations, otherwise the Roman conversion must not take place:

Eg. A sentence that reads: Vergelyk Hand. vii. 12, en die ook by v. 1.

"Hand." will appear in my list but "by" will not. So it needs to convert to:

Vergelyk Hand. 7:12 en ook by v. 1.

The way the code currently stand it will convert to:

Vergelyk Hand. 7:12 en ook by 5:1.
Reply With Quote
  #4  
Old 01-08-2021, 06:02 AM
WJSwanepoel WJSwanepoel is offline Word Macro to convert Roman references Windows 10 Word Macro to convert Roman references Office 2007
Advanced Beginner
Word Macro to convert Roman references
 
Join Date: Dec 2019
Location: Krugersdorp, South Africa
Posts: 38
WJSwanepoel is on a distinguished road
Default

Not to worry Paul. I managed to complete the final step myself.
Reply With Quote
  #5  
Old 01-08-2021, 01:04 PM
macropod's Avatar
macropod macropod is offline Word Macro to convert Roman references Windows 10 Word Macro to convert Roman references Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,225
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

Quote:
Originally Posted by WJSwanepoel View Post
Eg. A sentence that reads: Vergelyk Hand. vii. 12, en die ook by v. 1.

"Hand." will appear in my list but "by" will not. So it needs to convert to:

Vergelyk Hand. 7:12 en ook by v. 1.
As coded, that example won't be converted at all, since the numbering format is not as you described, which had a roman numeral, followed by a period, space single digit, period (which was to be deleted). The code looks for and processes only the specific sequence you described. Even allowing for multiple digits and no period, via:
Code:
.Text = "[A-Z][a-z]{1,3}. [iIvVxXlLmMcCdD]{1,}. [0-9]@>"
your second expression would not be processed, since it lacks the starting capital.

If there remains a risk of false matches, you could replace:
Code:
    .Text = Split(.Text, ".")(0) & ". " & _
        Roman2Num(Trim(Split(.Text, ".")(1))) & _
        ":" & Trim(Split(.Text, ".")(2))
with:
Code:
    If InStr("|Bob|Hope|", "|" & Split(.Text, ".")(0) & "|") > 0 Then
      .Text = Split(.Text, ".")(0) & ". " & _
        Roman2Num(Trim(Split(.Text, ".")(1))) & _
        ":" & Trim(Split(.Text, ".")(2))
    End If
where "|Bob|Hope|" is your set of valid abbreviations, each bounded by a | character.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
Reply

Thread Tools
Display Modes


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
Word Macro to convert Roman references 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
Word Macro to convert Roman references Regular (roman) character style doesn't change text to roman kcbenson Word 2 10-16-2014 01:31 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 01:12 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2021, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2021 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft