Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Ever needed to convert a Number into a Roman Numeral

Module Stuff

Ever needed to convert a Number into a Roman Numeral

by  rhicks  Posted    (Edited  )
This function will convert any number between 1 and 3999 to a Roman Numeral.

Public Function dhRoman(ByVal intValue As Integer) As String
Dim varDigits As Variant
Dim intPos As Integer
Dim IntDigit As Integer
Dim strTemp As String

' Build up the array of roman digits
varDigits = Array("I", "V", "X", "L", "C", "D", "M")
intPos = LBound(varDigits)
strTemp = ""

Do While intValue > 0
IntDigit = intValue Mod 10
intValue = intValue \ 10
Select Case IntDigit
Case 1
strTemp = varDigits(intPos) & strTemp
Case 2
strTemp = varDigits(intPos) & varDigits(intPos) _
& strTemp
Case 3
strTemp = varDigits(intPos) & varDigits(intPos) _
& varDigits(intPos) & strTemp
Case 4
strTemp = varDigits(intPos) & varDigits(intPos + 1) _
& strTemp
Case 5
strTemp = varDigits(intPos + 1) & strTemp
Case 6
strTemp = varDigits(intPos + 1) & varDigits(intPos) _
& strTemp
Case 7
strTemp = varDigits(intPos + 1) & varDigits(intPos) _
& varDigits(intPos) & strTemp
Case 8
strTemp = varDigits(intPos + 1) & varDigits(intPos) _
& varDigits(intPos) & varDigits(intPos) & strTemp
Case 9
strTemp = varDigits(intPos) & varDigits(intPos + 2) _
& strTemp
End Select

intPos = intPos + 2
Loop

dhRoman = strTemp

End Function

HTH
RDH
Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top