-
Aug 8th, 2006, 11:26 PM
#1
Number to Roman number conversion.
Dear all,
I want to convert the arabic numbers to roman numbers.Is there any function avliable.?
-
Aug 9th, 2006, 12:05 AM
#2
Lively Member
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
-
Aug 9th, 2006, 12:21 AM
#3
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:
Private Function Romanize(ByVal iNumber As Integer) As String
Dim iExp As Integer, iTest As Integer, sLetter As String
For iExp = 3 To 0 Step -1
iTest = iNumber \ (10 ^ iExp)
If iTest > 0 Then
Select Case iExp
Case 0
sLetter = "I"
Case 1
sLetter = "X"
Case 2
sLetter = "C"
Case 3
sLetter = "M"
End Select
Romanize = Romanize & String$(iTest, sLetter)
iNumber = iNumber - (iTest * (10 ^ iExp))
End If
Next iExp
Romanize = Replace(Romanize, "IIIIIIIII", "IX")
Romanize = Replace(Romanize, "IIIII", "V")
Romanize = Replace(Romanize, "IIII", "IV")
Romanize = Replace(Romanize, "XXXXXXXXX", "XC")
Romanize = Replace(Romanize, "XXXXX", "L")
Romanize = Replace(Romanize, "XXXX", "XL")
Romanize = Replace(Romanize, "CCCCCCCCC", "CM")
Romanize = Replace(Romanize, "CCCCC", "D")
Romanize = Replace(Romanize, "CCCC", "CD")
End Function
-
Aug 9th, 2006, 03:30 AM
#4
Re: Number to Roman number conversion.
How can I implement this for word vba
-
Aug 9th, 2006, 08:55 AM
#5
Re: Number to Roman number conversion.
VB Code:
Public Sub ConvertRoman()
Dim iNumber As Integer, sTest As String, sOut As String
On Error Resume Next
With Selection
If IsNumeric(.Range.Text) Then
iNumber = CInt(.Range.Text)
If Err.Number <> 0 Then
Exit Sub
MsgBox ("Number too big.")
Err.Clear
End If
.Range.Text = Romanize(iNumber)
Else
MsgBox ("Not a number")
End If
End With
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.
-
Aug 9th, 2006, 09:56 AM
#6
Re: Number to Roman number conversion.
-
Aug 9th, 2006, 12:10 PM
#7
Junior Member
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
-
Aug 9th, 2006, 12:17 PM
#8
Re: Number to Roman number conversion.
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|