Jedan moj mali doprinos

Code:
Option Explicit
Function RimskiBrojevi(Broj As Integer)

If Broj > 3999 Then
    RimskiBrojevi = "Morate uneti broj manji od 4000!"
    Exit Function
End If

Dim RB As String
Dim i As Integer
Dim jd As Integer, de As Integer, st As Integer, hi As Integer
Dim rjd As String, rde As String, rst As String, rhi As String

Broj = Round(Broj, 0)
RB = ""

Select Case Broj
    Case 1 To 9
        jd = Broj
    Case 10 To 99
        jd = Val(Mid(Str(Broj), 3, 1))
        de = Val(Mid(Str(Broj), 2, 1))
    Case 100 To 999
        jd = Val(Mid(Str(Broj), 4, 1))
        de = Val(Mid(Str(Broj), 3, 1))
        st = Val(Mid(Str(Broj), 2, 1))
    Case 1000 To 3999
        jd = Val(Mid(Str(Broj), 5, 1))
        de = Val(Mid(Str(Broj), 4, 1))
        st = Val(Mid(Str(Broj), 3, 1))
        hi = Val(Mid(Str(Broj), 2, 1))
End Select
       
'hiljade
If hi > 0 And hi < 4 Then
    For i = 1 To hi
        RB = RB & "M"
    Next i
End If

rhi = RB
RB = ""

'stotine
Select Case st
    Case 1 To 3
        For i = 1 To st
            RB = RB & "C"
        Next i
    Case 4
        RB = "CD"
    Case 5
        RB = "D"
    Case 6 To 8
        RB = "D"
        For i = 6 To st
            RB = RB & "C"
        Next i
    Case 9
        RB = "CM"
End Select

rst = RB
RB = ""

'desetice
Select Case de
    Case 1 To 3
        For i = 1 To de
            RB = RB & "X"
        Next i
    Case 4
        RB = "XL"
    Case 5
        RB = "L"
    Case 6 To 8
        RB = "L"
        For i = 6 To de
            RB = RB & "X"
        Next i
    Case 9
        RB = "XC"
End Select

rde = RB
RB = ""

'jedinice
Select Case jd
    Case 1 To 3
        For i = 1 To jd
            RB = RB & "I"
        Next i
    Case 4
        RB = "IV"
    Case 5
        RB = "V"
    Case 6 To 8
        RB = "V"
        For i = 6 To jd
            RB = RB & "I"
        Next i
    Case 9
        RB = "IX"
End Select

rjd = RB
RB = ""

RimskiBrojevi = rhi & rst & rde & rjd
End Function

Code:
Procedure : dhRoman
' Ulaz      : Broj
' Pov. vred : String koji daje rimski broj
' Primer    : Debug.Print dhRoman(1997); displays; "MCMXCVII",
'             Debug.Print dhRoman(3999) displays "MMMCMXCIX".
' Opis      : Converting a Number into Roman Numerals. If you're creating legal documents programmatically, or if your job involves copy-right notifications (well, it is somewhat difficult coming up with compelling scenarios for this one), you're likely to require the capability to convert integers into roman numerals. Although this need may not come up often, when it does, it's tricky enough that you'll want to avoid having to write the code yourself. The dhRoman function, in Listing, can accept an integer between 1 and 3999 (the Romans didn't have a concept of 0), and it returns the value converted into roman numerals. For example:
'             Attempting to convert a number greater than 3999 or less than 1 will raise a runtime error in dhRoman.
'            Convert Numbers to Roman Numerals
'            How does dhRoman do its work? As you probably know,
'            all numbers built in roman numerals between 1 and 3999
'            consist of the seven digits I, V, X, L, C, D, and M.
'            The I, X, C, and M digits represent 1, 10, 100, and 1000; V, L,
'            and D represent 5, 50, and 500, respectively. The code loops
'            through all the digits of your input value from right to left,
'            using the Mod operator to strip them off one by one:
'            Do While intValue > 0
'            intDigit = intValue Mod 10
'            intValue = intValue \ 10    ' (Code removed)
'            intPos = intPos + 2Loop
'            At each point in the loop, intDigit contains the
'            right-most digit of the value, and intValue keeps
'            getting smaller, one digit at a time. For example, the
'            following table shows the values of the two variables
'            while dhRoman tackles the value 1234:In addition,
'            intPos indicates which array element to use in building
'            the string as the code moves through the ones, tens, hundreds,
'            and thousands places in the value.Based on the value in intDigit,
'            the code uses a Select Case construct to choose the characters
'            to prepend to the output string. (That's right-prepend.
'            dhRoman constructs the output string from right to left,
'            adding items to the left of the string as it works.) For example,
'            for the value 1234, dhRoman finds the digit 4 when int-Pos is 0.
'            The code says to usestrTemp = varDigits(intPos) &
'            _ varDigits(intPos + 1) & strTempin this case. Because intPos is 0,
'            the output is IV (varDigits(0) & varDigits(1)). If the 4 had been
'            in the hundreds place (imagine you're converting 421 to roman numerals),
'            then intPos woud be 2, the expression would say to use varDigits(4)
'            & varDigits(5), and the output would be "CD" for this digit.
'---------------------------------------------------------------------------------------
Public Function dhRoman(ByVal intValue As Integer) As String
    Dim varDigits As Variant
    Dim lngPos As Integer
    Dim intDigit As Integer
    Dim strTemp As String
        ' Build up the array of roman digits
On Error GoTo dhRoman_Error
    varDigits = Array("I", "V", "X", "L", "C", "D", "M")
    lngPos = LBound(varDigits)
    strTemp = ""
Do While intValue > 0
        intDigit = intValue Mod 10
        intValue = intValue \ 10
        Select Case intDigit
            Case 1
                strTemp = varDigits(lngPos) & strTemp
            Case 2
                strTemp = varDigits(lngPos) & varDigits(lngPos) & strTemp
            Case 3
                strTemp = varDigits(lngPos) & varDigits(lngPos) & varDigits(lngPos) & strTemp
            Case 4
                strTemp = varDigits(lngPos) & varDigits(lngPos + 1) & strTemp
            Case 5
                strTemp = varDigits(lngPos + 1) & strTemp
            Case 6
                strTemp = varDigits(lngPos + 1) & varDigits(lngPos) & strTemp
            Case 7
                strTemp = varDigits(lngPos + 1) & varDigits(lngPos) & varDigits(lngPos) & strTemp
            Case 8
                strTemp = varDigits(lngPos + 1) & varDigits(lngPos) & varDigits(lngPos) & varDigits(lngPos) & strTemp
            Case 9
                strTemp = varDigits(lngPos) & varDigits(lngPos + 2) & strTemp
        End Select
        lngPos = lngPos + 2
    Loop
    dhRoman = strTemp
On Error GoTo 0
   Exit Function
dhRoman_Exit:
   Exit Function
dhRoman_Error:
   MsgBox "Greška: " & Err.Number & vbCrLf & "Opis: " & Err.Description & vbCrLf & "U proceduti: dhRoman"
Resume dhRoman_Exit
End Function