Je n'avais pas mis le code pour ne pas encombrer le sujet.
Donc, voici mon code. Je n'ai pas traité le montant >= un million mais on peut l'ajouter si nécessaire.
Function ChifLettre(montant)
' Constantes
Unité = Array("", "UN", "DEUX", "TROIS", "QUATRE", "CINQ", "SIX", "SEPT", "HUIT", "NEUF" )
Dizunité = Array("", "ONZE", "DOUZE", "TREIZE", "QUATORZE", "QUINZE", "SEIZE" )
dizaine = Array("", "DIX", "VINGT", "TRENTE", "QUARANTE", "CINQUANTE", "SOIXANTE", "SOIXANTE DIX", "QUATRE VINGT", "QUATRE VINGT DIX" )
' ************************************
If IsNumeric(montant) = False Then
L = "valeur non numérique"
GoTo fin
End If
chif_euros = Abs(Fix(montant))
' recherche centaine millier "
qcm = chif_euros \ 100000
rcm = chif_euros Mod 100000
If qcm > 9 Then
L = "montant non pris en charge"
GoTo fin
End If
If qcm > 1 Then
L = Unité(qcm) & " "
End If
If qcm > 0 Then
L = L & "CENT" & " "
End If
' recherche millier "
qm = rcm \ 1000
rm = rcm Mod 1000
If qm = 1 And L <> Empty _
Or qm > 1 Then
qd = qm \ 10
rd = qm Mod 10
GoSub dizaine
L = L & D
End If
If qcm > 0 Or qm > 0 Then
L = L & "MILLE" & " "
End If
' recherche centaine "
qc = rm \ 100
rc = rm Mod 100
If qc > 1 Then
L = L & Unité(qc) & " "
End If
If qc > 0 Then
L = L & "CENT" & " "
End If
' recherche dizaine "
qd = rc \ 10
rd = rc Mod 10
GoSub dizaine
L = L & D
If chif_euros > 1 Then
L = L & "EUROS" & " "
End If
If chif_euros = 1 Then
L = L & "EURO" & " "
End If
' recherche centimes "
Dim chif_millième As Integer
Dim quotient As Integer
Dim reste As Integer
chif_millième = Int((Abs(montant) - chif_euros) * 1000)
quotient = chif_millième \ 10
reste = chif_millième Mod 10
If reste < 5 Then
chif_centimes = quotient
Else
chif_centimes = quotient + 1
End If
qd = chif_centimes \ 10
rd = chif_centimes Mod 10
GoSub dizaine
If Int(chif_centimes) > 1 Then
Lc = "ET " & D & "CENTIMES"
End If
If Int(chif_centimes) = 1 Then
Lc = "ET " & D & "CENTIME"
End If
' fin fonction
GoTo fin
' ***************** fonction dizaine *******************
dizaine:
lien = ""
If qd = 0 Then
i3 = rd
i2 = 0
i1 = 0
End If
If qd = 1 Then
If rd > 0 And rd < 7 Then
i3 = 0
i2 = rd
i1 = 0
Else
i3 = rd
i2 = 0
i1 = qd
If rd > 0 Then
lien = " "
End If
End If
End If
If qd > 1 And qd < 7 Or qd = 8 Then
i3 = rd
i2 = 0
i1 = qd
If rd = 1 And qd <> 8 Then
lien = " ET "
Else
lien = " "
End If
End If
If qd = 7 Or qd = 9 Then
lien = " "
If rd > 0 And rd < 7 Then
i3 = 0
i2 = rd
i1 = qd - 1
Else
i3 = rd
i2 = 0
i1 = qd
End If
End If
D = dizaine(i1) & lien & Dizunité(i2) & Unité(i3) & " "
Return
' ***************** fin routine dizaine *******************
fin:
ChifLettre = L & Lc
End Function
Message édité par thev le 11-07-2008 à 11:54:36