[Graham Mayor]

I thought it would be wheel re-invention

Sub ConvertSelectedToRomanNumerals2()
Dim sNum As String
Dim sFont As String
sNum = Selection
If sNum = "" Then Exit Sub
With Selection
sFont = .Font.Name
.Font.Name = "Times New Roman"
.Fields.Add Range:=Selection.Range, _
Type:=wdFieldEmpty, Text:= _
"= " & sNum & " \*ROMAN", _
PreserveFormatting:=False
.MoveLeft Unit:=wdCharacter, Count:=1
.Fields.Unlink
.MoveRight Unit:=wdCharacter, Count:=1
.Font.Name = sFont
End With
End Sub

is somewhat simpler

--

Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site http://word.mvps.org


Graham Mayor wrote:
It's probably a touch of wheel re-invention but the following macro
will convert selected numbers up to 2999 to Roman numerals

Sub ConvertSelectedToRomanNumerals()
Dim iNum As String
Dim iUnits As String
Dim iTens As String
Dim iHundreds As String
Dim iThousands As String

iNum = Selection
On Error GoTo Oops:

iUnits = Right(iNum, 1)
Select Case iUnits
Case Is = 1
iUnits = "I"
Case Is = 2
iUnits = "II"
Case Is = 3
iUnits = "III"
Case Is = 4
iUnits = "IV"
Case Is = 5
iUnits = "V"
Case Is = 6
iUnits = "VI"
Case Is = 7
iUnits = "VII"
Case Is = 8
iUnits = "VIII"
Case Is = 9
iUnits = "IX"
Case Else
iUnits = ""
End Select

If iNum 9 Then
iTens = Mid(iNum, Len(iNum) - 1, 1)
Select Case iTens
Case Is = 1
iTens = "X"
Case Is = 2
iTens = "XX"
Case Is = 3
iTens = "XXX"
Case Is = 4
iTens = "XL"
Case Is = 5
iTens = "L"
Case Is = 6
iTens = "LX"
Case Is = 7
iTens = "LXX"
Case Is = 8
iTens = "LXXX"
Case Is = 9
iTens = "XC"
Case Else
iTens = ""
End Select
Else
iTens = ""
End If

If iNum 99 Then
iHundreds = Mid(iNum, Len(iNum) - 2, 1)

Select Case iHundreds
Case Is = 1
iHundreds = "C"
Case Is = 2
iHundreds = "CC"
Case Is = 3
iHundreds = "CCC"
Case Is = 4
iHundreds = "CD"
Case Is = 5
iHundreds = "D"
Case Is = 6
iHundreds = "DC"
Case Is = 7
iHundreds = "DCC"
Case Is = 8
iHundreds = "DCCC"
Case Is = 9
iHundreds = "MC"
Case Else
iHundreds = ""
End Select
Else
iHundreds = ""
End If

If iNum 999 Then
iThousands = Left(iNum, Len(iNum) - 3)
Select Case iThousands
Case Is = 1
iThousands = "M"
Case Is = 2
iThousands = "MM"
Case Else
MsgBox "Numbers greater than 2999 are not valid"
Exit Sub
End Select
Else
iThousands = ""
End If

With Selection
.Font.Name = "Times New Roman"
.Font.Bold = True
.TypeText iThousands & iHundreds & iTens & iUnits
End With
Exit Sub

Oops:
MsgBox "Select the number and try again"

End Sub

http://www.gmayor.com/installing_macro.htm


MedicalTranscriptionstudent wrote:
I am trying to type proper formatted roman numerals. I would like to
set them up in autocorrect but I can not find them in either symbols
or under any of the fonts. Help?