NUMBERTOROMAN
Returns a string concatenation of Roman Numerals converted from an English Language string.
For instructions on how to add a function to a workbook refer to the page under Inserting Functions
'strSource - The string containing the number to convert. Valid numbers are 1 to 3000 inclusive
'strRes - The Roman Numeral value after successful conversion
'strError - A description of why the conversion was not successful
Public Function NumberToRoman( _
ByVal strSource As Variant, _
ByRef strRes As Variant, _
ByRef strError As Variant) As Boolean
Dim arRomans As Variant
Dim lposition As Long
Dim sroman As String
On Error GoTo ErrorHandler
If (NumberToRoman_Validation(strSource, strRes, strError) = False) Then
NumberToRoman = False
Exit Function
End If
arRomans = Array("", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")
Do While (VBA.Len(strSource) > 0)
sroman = arRomans(VBA.Left(strSource, 1))
Select Case VBA.Len(strSource)
Case 2: sroman = VBA.Replace(VBA.Replace(VBA.Replace(sroman, "X", "C"), "V", "L"), "I", "X")
Case 3: sroman = VBA.Replace(VBA.Replace(VBA.Replace(sroman, "X", "M"), "V", "D"), "I", "C")
Case 4: sroman = VBA.Replace(sroman, "I", "M")
Case Else:
End Select
strRes = strRes & sroman
strSource = VBA.Right(strSource, VBA.Len(strSource) - 1)
Loop
strError = Empty
NumberToRoman = True
Exit Function
ErrorHandler:
strRes = Empty
strError = "Error"
NumberToRoman = False
End Function
Private Function NumberToRoman_Validation( _
ByVal strSource As Variant, _
ByRef strRes As Variant, _
ByRef strError As Variant) As Boolean
On Error GoTo ErrorHandler
NumberToRoman_Validation = False
If (VBA.IsNumeric(strSource) = False) Then
strError = "Numerical values only, no text allowed"
Exit Function
End If
If (VBA.Val(strSource) < 0) Then
strError = "Negative values are not allowed"
Exit Function
End If
If (VBA.Val(strSource) < 1) Or (VBA.Val(strSource) > 3000) Then
strError = "Numbers must be between 1 and 3000 inclusive"
Exit Function
End If
NumberToRoman_Validation = True
Exit Function
ErrorHandler:
NumberToRoman_Validation = False
End Function
Returns - Boolean, True = success, False = failure
There is also a built in ROMAN function.
© 2024 Better Solutions Limited. All Rights Reserved. © 2024 Better Solutions Limited TopPrevNext