Results 1 to 8 of 8

Thread: Number to Roman number conversion.

  1. #1

    Thread Starter
    Learning .Net danasegarane's Avatar
    Join Date
    Aug 2004
    Location
    VBForums
    Posts
    5,853

    Number to Roman number conversion.

    Dear all,
    I want to convert the arabic numbers to roman numbers.Is there any function avliable.?

  2. #2
    Lively Member
    Join Date
    Jan 2001
    Location
    Ca
    Posts
    124

    Re: Number to Roman number conversion.

    Hey

    I'm not sure where i got this code. Or what Language it was written in?

    Reston


    Vb Code ______________________________________________
    Private Sub Command1_Click()
    Dim sayý As String
    Dim birlikkýsým, onlukkýsým, yüzlükkýsým, birlikkýsým1 As Integer
    sayý = Text1.Text
    Text1.Text = ""
    If Len(sayý) = 1 Then
    Text1.Text = Birlik(CInt(sayý))
    ElseIf Len(sayý) = 2 Then
    birlikkýsým = CInt(sayý) - (Int(CInt(sayý) / 10) * 10)
    Text1.Text = Onluk(CInt(sayý)) & Birlik(CInt(birlikkýsým))
    ElseIf Len(sayý) = 3 Then
    onlukkýsým = CInt(sayý) - (Int(CInt(sayý) / 100) * 100)
    If onlukkýsým < 10 Then
    birlikkýsým = CInt(Right(sayý, 1))
    Text1.Text = Yüzlük(CInt(sayý)) & Birlik(CInt(birlikkýsým))
    ElseIf onlukkýsým >= 10 Then
    birlikkýsým = onlukkýsým - (Int(onlukkýsým / 10) * 10)
    Text1.Text = Yüzlük(CInt(sayý)) & Onluk(CInt(onlukkýsým)) & Birlik(CInt(birlikkýsým))
    End If

    ElseIf Len(sayý) >= 4 Then
    yüzlükkýsým = CLng(sayý) - (Int(CLng(sayý) / 1000) * 1000)
    If yüzlükkýsým >= 100 Then
    onlukkýsým = yüzlükkýsým - (Int(yüzlükkýsým / 100) * 100)
    If onlukkýsým >= 10 Then
    birlikkýsým = onlukkýsým - (Int(onlukkýsým / 10) * 10)
    Text1.Text = Binlik(CLng(sayý)) & Yüzlük(CInt(yüzlükkýsým)) & Onluk(CInt(onlukkýsým)) & Birlik(CInt(birlikkýsým))
    ElseIf onlukkýsým < 10 Then
    birlikkýsým = CInt(Right(sayý, 1))
    Text1.Text = Binlik(CLng(sayý)) & Yüzlük(CInt(sayý)) & Birlik(CInt(birlikkýsým))
    End If

    ElseIf yüzlükkýsým < 100 Then
    onlukkýsým = CInt(Mid(Right(sayý, 2), 1, 1)) * 10
    If onlukkýsým >= 10 Then
    birlikkýsým = onlukkýsým - (Int(onlukkýsým / 10) * 10)
    Text1.Text = Binlik(CLng(sayý)) & Onluk(CInt(onlukkýsým)) & Birlik(CInt(birlikkýsým))
    ElseIf onlukkýsým < 10 Then
    birlikkýsým = CInt(Right(sayý, 1))
    Text1.Text = Binlik(CLng(sayý)) & Birlik(CInt(birlikkýsým))
    End If
    End If
    End If
    End Sub
    Private Function Onluk(sayý As Integer) As String


    Dim elli As String
    sonuc = ""
    elli = "L"
    If CInt(Left(CStr(sayý), 1)) < 4 Then
    For i = 1 To CInt(Left(CStr(sayý), 1))
    sonuc = sonuc & "X"
    Next i
    ElseIf CInt(Left(CStr(sayý), 1)) = 4 Then
    sonuc = "CL"
    ElseIf CInt(Left(CStr(sayý), 1)) = 5 Then
    sonuc = "L"
    ElseIf CInt(Left(CStr(sayý), 1)) > 5 And CInt(Left(CStr(sayý), 1)) < 9 Then
    sonuc = sonuc & elli
    For i = 1 To CInt(Left(CStr(sayý), 1)) - 5
    sonuc = sonuc & "X"
    Next i
    ElseIf CInt(Left(CStr(sayý), 1)) = 9 Then
    sonuc = "XC"
    ElseIf CInt(Left(CStr(sayý), 1)) = 0 Then
    Exit Function
    End If
    Onluk = sonuc

    End Function
    Private Function Birlik(sayý As Integer) As String

    Dim beþ As String
    sonuc = ""
    beþ = "V"
    If CInt(Left(CStr(sayý), 1)) < 4 Then
    For i = 1 To CInt(Left(CStr(sayý), 1))
    sonuc = sonuc & "I"
    Next i
    ElseIf CInt(Left(CStr(sayý), 1)) = 4 Then
    sonuc = "IV"
    ElseIf CInt(Left(CStr(sayý), 1)) = 5 Then
    sonuc = "V"
    ElseIf CInt(Left(CStr(sayý), 1)) > 5 And CInt(Left(CStr(sayý), 1)) < 9 Then
    sonuc = sonuc & beþ
    For i = 1 To CInt(Left(CStr(sayý), 1)) - 5
    sonuc = sonuc & "I"
    Next i
    ElseIf CInt(Left(CStr(sayý), 1)) = 9 Then
    sonuc = "IX"
    End If
    Birlik = sonuc
    End Function
    Private Function Yüzlük(sayý As Integer) As String
    Dim beþyüz As String
    sonuc = ""
    beþyüz = "D"
    If CInt(Left(CStr(sayý), 1)) < 4 Then
    For i = 1 To CInt(Left(CStr(sayý), 1))
    sonuc = sonuc & "C"
    Next i
    ElseIf CInt(Left(CStr(sayý), 1)) = 4 Then
    sonuc = "CD"
    ElseIf CInt(Left(CStr(sayý), 1)) = 5 Then
    sonuc = "D"
    ElseIf CInt(Left(CStr(sayý), 1)) > 5 And CInt(Left(CStr(sayý), 1)) < 9 Then
    sonuc = sonuc & beþyüz
    For i = 1 To CInt(Left(CStr(sayý), 1)) - 5
    sonuc = sonuc & "C"
    Next i
    ElseIf CInt(Left(CStr(sayý), 1)) = 9 Then
    sonuc = "CM"
    ElseIf CInt(Left(CStr(sayý), 1)) = 0 Then
    Exit Function
    End If
    Yüzlük = sonuc
    End Function
    Private Function Binlik(sayý As Long) As String
    Dim binliksayý As Integer
    sonuc = ""
    binliksayý = Int(sayý / 1000)
    If binliksayý = 1 Then
    sonuc = "M"
    ElseIf binliksayý > 1 Then
    For i = 1 To binliksayý
    sonuc = sonuc & "M"
    Next i
    End If
    Binlik = sonuc
    End Function

  3. #3
    Fanatic Member Comintern's Avatar
    Join Date
    Nov 2004
    Location
    Lincoln, NE
    Posts
    826

    Re: Number to Roman number conversion.

    I just cooked this up, might be a little easier to follow and works for numbers up to 5000 (after that, you put bars over the letters, which you can't do in the ASCII character set).
    VB Code:
    1. Private Function Romanize(ByVal iNumber As Integer) As String
    2.  
    3.     Dim iExp As Integer, iTest As Integer, sLetter As String
    4.    
    5.     For iExp = 3 To 0 Step -1
    6.         iTest = iNumber \ (10 ^ iExp)
    7.         If iTest > 0 Then
    8.             Select Case iExp
    9.                 Case 0
    10.                     sLetter = "I"
    11.                 Case 1
    12.                     sLetter = "X"
    13.                 Case 2
    14.                     sLetter = "C"
    15.                 Case 3
    16.                     sLetter = "M"
    17.             End Select
    18.             Romanize = Romanize & String$(iTest, sLetter)
    19.             iNumber = iNumber - (iTest * (10 ^ iExp))
    20.         End If
    21.     Next iExp
    22.    
    23.     Romanize = Replace(Romanize, "IIIIIIIII", "IX")
    24.     Romanize = Replace(Romanize, "IIIII", "V")
    25.     Romanize = Replace(Romanize, "IIII", "IV")
    26.     Romanize = Replace(Romanize, "XXXXXXXXX", "XC")
    27.     Romanize = Replace(Romanize, "XXXXX", "L")
    28.     Romanize = Replace(Romanize, "XXXX", "XL")
    29.     Romanize = Replace(Romanize, "CCCCCCCCC", "CM")
    30.     Romanize = Replace(Romanize, "CCCCC", "D")
    31.     Romanize = Replace(Romanize, "CCCC", "CD")
    32.    
    33. End Function

  4. #4

    Thread Starter
    Learning .Net danasegarane's Avatar
    Join Date
    Aug 2004
    Location
    VBForums
    Posts
    5,853

    Re: Number to Roman number conversion.

    How can I implement this for word vba

  5. #5
    Fanatic Member Comintern's Avatar
    Join Date
    Nov 2004
    Location
    Lincoln, NE
    Posts
    826

    Re: Number to Roman number conversion.

    VB Code:
    1. Public Sub ConvertRoman()
    2.  
    3.     Dim iNumber As Integer, sTest As String, sOut As String
    4.    
    5.     On Error Resume Next
    6.    
    7.     With Selection
    8.         If IsNumeric(.Range.Text) Then
    9.             iNumber = CInt(.Range.Text)
    10.             If Err.Number <> 0 Then
    11.                 Exit Sub
    12.                 MsgBox ("Number too big.")
    13.                 Err.Clear
    14.             End If
    15.             .Range.Text = Romanize(iNumber)
    16.         Else
    17.             MsgBox ("Not a number")
    18.         End If
    19.     End With
    20.  
    21. End Sub
    Drop this code and the previous function into a module. Just select a number in the document, run the macro, and it will be converted.

  6. #6

  7. #7
    Junior Member
    Join Date
    Aug 2006
    Posts
    23

    Re: Number to Roman number conversion.

    You may want to add in a simple checking part to the Romanize function to see if the value passed is 5000 or less.

    edit: so i read your convertroman part now and see the checking part

  8. #8
    Fanatic Member Comintern's Avatar
    Join Date
    Nov 2004
    Location
    Lincoln, NE
    Posts
    826

    Re: Number to Roman number conversion.

    Quote Originally Posted by longbowaj
    You may want to add in a simple checking part to the Romanize function to see if the value passed is 5000 or less.

    edit: so i read your convertroman part now and see the checking part
    No, that actually is a good suggestion--the check you are refering to only makes sure that the input doesn't overflow an integer. The function won't error for numbers larger than 5000, it will just look kind of silly. For example, it will convert 12345 into MMMMMMMMMMMMCCCXLV.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width