Function dhRoman(ByVal intValue As Integer) As String
' Convert a decimal number between 1 and 3999
' into a Roman number.
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.
' In:
' intValue:
' A value between 1 and 3999 to be converted
' to roman numerals.
' Out:
' Return Value:
' The roman numeral representation of the integer
' Example:
' dhRoman(123) returns "CXXIII"
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
|