JoePatent
Messages postés171Date d'inscriptionjeudi 30 janvier 2003StatutMembreDernière intervention20 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és46Date d'inscriptionvendredi 14 février 2003StatutMembreDernière intervention13 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és171Date d'inscriptionjeudi 30 janvier 2003StatutMembreDernière intervention20 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és193Date d'inscriptionjeudi 14 février 2002StatutMembreDernière intervention25 mars 20111 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és780Date d'inscriptionlundi 16 décembre 2002StatutMembreDernière intervention16 avril 20091 23 juil. 2003 à 09:02
Le truc bien maintenant serait de faire l'inverse :)
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
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.