Public Function DecToRoman(ByVal lNum As Long) As String
    DecToRoman = Choose(((lNum Mod 10) / 1) + 1, "", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")
    lNum = lNum - (lNum Mod 10)
    DecToRoman = Choose(((lNum Mod 100) / 10) + 1, "", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC") & DecToRoman
    lNum = lNum - (lNum Mod 100)
    DecToRoman = String$((lNum \ 1000), "M") & Choose(((lNum Mod 1000) / 100) + 1, "", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM") & DecToRoman
End Function

Public Function DecToRoman(ByVal lNum As Long) As String
    DecToRoman = Choose(((lNum Mod 10) / 1) + 1, "", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")
    lNum = lNum - (lNum Mod 10)
    If lNum Then
        DecToRoman = Choose(((lNum Mod 100) / 10) + 1, "", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC") & DecToRoman
        lNum = lNum - (lNum Mod 100)
        If lNum Then
            DecToRoman = String$((lNum \ 1000), "M") & Choose(((lNum Mod 1000) / 100) + 1, "", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM") & DecToRoman
        End If
    End If
End Function

Private Function RomanToDecimal(RomNum As String) As String
 
    Dim VectorRom()         As Integer 'Lo lleno con los valores de las letras
    Dim Tam                 As Integer 'Tamaño del numero Romano
    Dim X                   As Integer 'Para los Bucles
    Dim SumaRom             As Integer 'Acumulador
 
    Tam = Len(RomNum)
 
    If Tam = 0 Then
        RomanToDecimal = 0
        Exit Function
    End If
 
    ReDim VectorRom(1 To Tam)
 
    For X = 1 To Tam
        Select Case Mid$(RomNum, X, 1)
            Case "M":   VectorRom(X) = 1000
            Case "D":   VectorRom(X) = 500
            Case "C":   VectorRom(X) = 100
            Case "L":   VectorRom(X) = 50
            Case "X":   VectorRom(X) = 10
            Case "V":   VectorRom(X) = 5
            Case "I":   VectorRom(X) = 1
        End Select
    Next
 
    For X = 1 To Tam
        If X = Tam Then
            SumaRom = SumaRom + VectorRom(X)
        Else
            If VectorRom(X) >= VectorRom(X + 1) Then
                SumaRom = SumaRom + VectorRom(X)
            Else
                SumaRom = SumaRom - VectorRom(X)
            End If
        End If
    Next
 
    RomanToDecimal = CStr(SumaRom)
 
End Function