Les Snippets

Nouveaux snippets
Snippets les plus consultés
Proposer un snippet

 Abonnez vous à ce fil d'information Les rss

Rechercher :

Par langages :

Par Catégorie

Compteurs


Nombre de sujets : 509
Nombre de snippets : 1574
Connexion

Conversion de nombres Romain en Décimal

Niveau requis pour utiliser/comprendre cette source : 1 ( Débutant )
Créé le 15/01/2008 22:10:50 et initié par casy [Liste]
Date de mise à jour : 16/01/2008 09:49:18
Vue : 3178
Catégorie(s) : Maths
Langages dispo pour ce code :
- VB6, VBA
- VB 2005
- Delphi 5
- Java
- Voir tous les langages pour ce code snippet
Proposer ce code dans un autre langage



Langage : VB6 , VBA
Date ajout : 15/01/2008
Posté par casy [Liste]
DateMAJ : 16/01/2008 
Public Function CVTRomDec(valeur As String) As Long
'Pour Excel en cellule : Public Function CVTRomDec(cellule  As  Range) As Long
'Dim valeur  As  String
'valeur  =  CStr(cellule.value)
Dim sum As Long
Dim incr As Long
Dim decr As Long
Dim i As Integer
If Len(valeur) = 0 Then
  CVTRomDec = 0
  Exit Function
End If
sum = 0
For i = Len(valeur) To 1 Step -1
  incr = 0
  decr = 0
  Select Case Mid(valeur, i, 1)
    Case "I"
      incr = 1
    Case "V"
      incr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
    Case "X"
      incr = 10
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
    Case "L"
      incr = 50
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "X" Then decr = 10
    Case "C"
      incr = 100
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "X" Then decr = 10
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "L" Then decr = 50
    Case "D"
      incr = 500
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "X" Then decr = 10
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "L" Then decr = 50
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "C" Then decr = 100
    Case "M"
      incr = 1000
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "X" Then decr = 10
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "L" Then decr = 50
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "C" Then decr = 100
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "D" Then decr = 500
    Case Else
      CVTRomDec = 0
      Exit Function
  End Select
  sum = sum + incr
  If decr <> 0 Then
    sum = sum - decr
    i = i - 1
  End If
Next
CVTRomDec = sum
End Function
Remarque :
Prévue pour VB6 et VBA, elle est facilement adaptable pour etre utilisée directement dans une cellule d'Excel (Voir Commentaire).

Snippets en rapport avec : Convertion, Romain

05/07/2008 - Binaire vers Hexa (BinToHex) et Hexa vers Binaire (HexToBin)

04/03/2007 - Convertion toutes données vers chaine representation binaire

17/09/2006 - Convertion de chaine ANSI>ASCII et ASCII>ANSI



Codes sources en rapport avec : Convertion, Romain

{Visual Basic, VB6, VB.NET, VB 2005} BMP TO TXT
Converti une Image BMP, en Texte ASCI. Grace a GetPixel. Et Donne un log a la fin, Qui informe sur...

{JAVA / J2EE} ROMANOP : UN UTILITAIRE POUR LES NOMBRES ROMAINS (CONVERSION ROMAN -> ENTIERS, ENTIERS -> ROMAINS, CALCULS...)
Voici une utilitaire sur les nombres romains. Il permet la conversion de nombres romains vers les en...

{Assembleur} FLOATTOHEX CODE DE BRUNEWS RETRENSCRIS EN ASM PAR MOI
convertis nombre reel en simple et double hexadecimal petit utilitaire pour dévelopeur trés utile a...

{C / C++ / C++.NET} CONVERTION PS EN NOIR ET BLANC
Petit executable qui converti une liste de fichiers PostScript en noir et Blanc, ne converti que les...

{JAVA / J2EE} VERSION JAVA DE : ROMANUTILS, TOUT POUR CONVERTIR LES CHIFFRES ROMAINS VERS LES ENTIERS ET INVERSEMENT
Rapide portage de l'excellente source Delphi disponible à http://www.delphifr.com/code.aspx?ID=344...

{Delphi} CONVERTION D'UNE CHAINE EN TDATE
converti une chaine de caractère en TDate, comme StrToDate, mais fonctionne un peu comme dans Access...

{C / C++ / C++.NET} CONVERTIR CHEMIN RELATIF EN CHEMIN ABSOLUE (POUR DISQUE DUR)
ce code est un complement de l'utilisation de GetFullPathName() qui necessite un fichier existant ...

{PHP} CLASS DE COULEUR
Suite à un commentaire interessant de Coucou747 sur la source "PHP5-CLASSE-CONVERSION-RGB-HEXA", j'a...

{PHP} CONVERTION D'UN FICHIER GEDCOM (GÉNÉALOGIQUE) EN CALENDRIER CSV POUR OUTLOOK
NOUVEAU : créer une liste .ldif des adresses mail de votre arbre généalogique, pour thunderbird. ...

{PHP} FONCTION DE CONVERSION D'UNE CHAINE DE CARACTÈRE VERS UN TYPAGE UNIX
Bonjour, Alors cette fonction permet de convertir n'importe quelle chaine de caractère en une équiv...