Option
Explicit
Public
Sub
convert()
Dim
sInput
As
String
sInput = InputBox(
"Bitte geben Sie eine Zahl ein:"
)
If
Not
IsNumeric(sInput)
Then
MsgBox
"Das war keine Zahl.."
, vbExclamation
Exit
Sub
End
If
MsgBox
"Arabisch: "
& sInput & vbCrLf & _
"Römisch: "
& fktRoman(sInput), vbInformation
End
Sub
Public
Function
fktRoman(
ByVal
Arab
As
Long
)
As
String
Dim
Arabisch
As
Variant
, Roemisch
As
Variant
, Roem
As
String
, I
As
Long
Arabisch = Array(1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000)
Roemisch = Array(
"I"
,
"IV"
,
"V"
,
"IX"
,
"X"
,
"XL"
,
"L"
,
"XC"
, _
"C"
,
"CD"
,
"D"
,
"CM"
,
"M"
)
For
I = UBound(Arabisch)
To
LBound(Arabisch)
Step
-1
Do
While
Arab >= Arabisch(I)
Arab = Arab - Arabisch(I)
Roem = Roem + Roemisch(I)
Loop
Next
I
fktRoman = Roem
End
Function
VBA Editor schließen und dann in Excel unter Entwicklertools das Makro
"convert"
aufrufen.
Gruß