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?