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
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

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
Salut Philoo,

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.
philoo91 Messages postés 46 Date d'inscription vendredi 14 février 2003 Statut Membre Dernière intervention 13 juillet 2009
5 août 2003 à 14:10
Kikou la bande,
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
JoePatent Messages postés 171 Date d'inscription jeudi 30 janvier 2003 Statut Membre Dernière intervention 20 juillet 2008
23 juil. 2003 à 15:27
Il manque de la validation. CCCCCCCC = 800 selon ce programme.
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 ! :-)
metalcoder Messages postés 193 Date d'inscription jeudi 14 février 2002 Statut Membre Dernière intervention 25 mars 2011 1
23 juil. 2003 à 09:21
j'avais fait cette source avec un gars pour son BTS je crois. j'ai pas le temps mais si j'en trouve je rajouterai la fonction.

@+
cs_Urgo Messages postés 780 Date d'inscription lundi 16 décembre 2002 Statut Membre Dernière intervention 16 avril 2009 1
23 juil. 2003 à 09:02
Le truc bien maintenant serait de faire l'inverse :)
Afficher les 6 commentaires