CONVERTION CHIFFRE ROMAIN<>DECIMAL
cs_Urgo
Messages postés
780
Date d'inscription
lundi 16 décembre 2002
Statut
Membre
Dernière intervention
16 avril 2009
-
23 juil. 2003 à 09:01
JoePatent Messages postés 171 Date d'inscription jeudi 30 janvier 2003 Statut Membre Dernière intervention 20 juillet 2008 - 5 août 2003 à 19:50
JoePatent Messages postés 171 Date d'inscription jeudi 30 janvier 2003 Statut Membre Dernière intervention 20 juillet 2008 - 5 août 2003 à 19:50
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/7635-convertion-chiffre-romain-lt-gt-decimal
https://codes-sources.commentcamarche.net/source/7635-convertion-chiffre-romain-lt-gt-decimal
5 août 2003 à 19:50
J'ai refais une source qui incorpore maintenant les deux conversions. Je me suis servit de la récursive qui permet de faire le tout en quelques lignes...
Il me manque de l'info pour la validation mais le reste fonctionne bien... Si jamais tu veux y jeter un coup d'oeil.
5 août 2003 à 14:10
Réjouissez vous v'la t'y pas qu'y a l'inverse : (Limité à 3999)
Public Function Arabe_To_Romain(ByVal Value As Integer) As String
Dim Roms As String
Dim RetVal As String
Dim I As Integer
Dim K As Integer
Roms = "IVXLCDM"
RetVal = ""
If Value < 4000 Then
For I = 1 To Len(Text1)
K = 2 * (Len(Text1) - I) + 1
Select Case Mid(Text1, I, 1)
Case "1": RetVal = RetVal & Mid(Roms, K, 1)
Case "2": RetVal = RetVal & Mid(Roms, K, 1) & Mid(Roms, K, 1)
Case "3": RetVal = RetVal & Mid(Roms, K, 1) & Mid(Roms, K, 1) & Mid(Roms, K, 1)
Case "4": RetVal = RetVal & Mid(Roms, K, 1) & Mid(Roms, K + 1, 1)
Case "5": RetVal = RetVal & Mid(Roms, K + 1, 1)
Case "6": RetVal = RetVal & Mid(Roms, K + 1, 1) & Mid(Roms, K, 1)
Case "7": RetVal = RetVal & Mid(Roms, K + 1, 1) & Mid(Roms, K, 1) & Mid(Roms, K, 1)
Case "8": RetVal = RetVal & Mid(Roms, K + 1, 1) & Mid(Roms, K, 1) & Mid(Roms, K, 1) & Mid(Roms, K, 1)
Case "9": RetVal = RetVal & Mid(Roms, K, 1) & Mid(Roms, K + 2, 1)
End Select
Next I
End If
Arabe_To_Romain = RetVal
End Function
23 juil. 2003 à 15:27
Il serait bien d'indiquer qu'il ne s'agit pas d'un chiffre romain. Mais sinon c'est bien. Je suis un peu décu aussi que la fonction inverse n'existe pas... mais bon ! :-)
23 juil. 2003 à 09:21
@+
23 juil. 2003 à 09:02
23 juil. 2003 à 09:01