Les Trucs & Astuces Informatiques de Michel

http://michel.vergriete.perso.sfr.fr/accueil.htm
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  

Partagez | 
 

 Calcul de chiffre en lettre , besoin d aide

Aller en bas 
AuteurMessage
mar rod



Nombre de messages : 1
Date d'inscription : 17/06/2008

MessageSujet: Calcul de chiffre en lettre , besoin d aide   Mar 17 Juin - 5:52

Bonjour
Voici mon code est-ce qu'il y a quelqu'un qui pourrait m'aider pour que lorsque nous avons 420 le vingt ne prenne pas de "s".
Merci à tous!
Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 2008-05-29 par Mario Rodrigue
'

'
Range("AD2:AD5").Select
Selection.Copy
Range("AF13").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

'Attribute VB_Name = "Module1"
Function PMod(V As Variant, D) As Variant
Dim R As Variant
Dim M As Variant
R = Int(V / D)
M = R * D
PMod = V - M
End Function
Function FrancEuro(F As Variant) As Double
FrancEuro = Arrondir(F / 6.55957, 2)
End Function
Function dollarsEnLettres(NB) As String
On Error GoTo dollarsEnLettres_suite
Dim Varnum As Long
Dim varnumD, varnumU, varlet, résultat
'varnum : pour stocker les parties du nombre que l'on va découper
'varlet : pour stocker la conversion en lettres d'une partie du nombre
'varnumD : pour stocker la partie dizaine d'un nombre à 2 chiffres
'varnumU : pour stocker la partie unité d'un nombre à 2 chiffres
'résultat : pour stocker les résultats intermédiaires des différentes étapes
Static chiffre(1 To 19) '*** tableau contenant le nom des 16 premiers nombres en lettres
chiffre(1) = "un"
chiffre(2) = "deux"
chiffre(3) = "trois"
chiffre(4) = "quatre"
chiffre(5) = "cinq"
chiffre(6) = "six"
chiffre(7) = "sept"
chiffre(Cool = "huit"
chiffre(9) = "neuf"
chiffre(10) = "dix"
chiffre(11) = "onze"
chiffre(12) = "douze"
chiffre(13) = "treize"
chiffre(14) = "quatorze"
chiffre(15) = "quinze"
chiffre(16) = "seize"
chiffre(17) = "dix-sept"
chiffre(18) = "dix-huit"
chiffre(19) = "dix-neuf"
Static dizaine(1 To Cool '*** tableau contenant les noms des dizaines
dizaine(1) = "dix"
dizaine(2) = "vingt"
dizaine(3) = "trente"
dizaine(4) = "quarante"
dizaine(5) = "cinquante"
dizaine(6) = "soixante"
dizaine(Cool = "quatre-vingt"
'*** Traitement du cas zéro Euro
If NB >= 1 Then
résultat = ""
Else
résultat = "zéro"
GoTo fintraitementdollars
End If
'*** Traitement des milliards
Varnum = Int(NB / 1000000000)
If Varnum > 0 Then
GoSub centaine_dizaine
résultat = varlet + " milliard"
If varlet <> "un" Then résultat = résultat + "s"
End If
'*** Traitement des millions
Varnum = Int(PMod(NB, 1000000000)) 'Int(NB) Mod 1000000000
Varnum = Int(Varnum / 1000000)
If Varnum > 0 Then
GoSub centaine_dizaine
résultat = résultat + " " + varlet + " million"
If varlet <> "un" Then résultat = résultat + "s"
End If

'*** Traitement des milliers
Varnum = Int(PMod(NB, 1000000))
Varnum = Int(Varnum / 1000)
If Varnum > 0 Then
GoSub centaine_dizaine
If varlet <> "un" Then résultat = résultat + " " + varlet
résultat = résultat + " mille"
End If

'*** Traitement des centaines et dizaines
Varnum = Int(PMod(NB, 1000)) 'Int(NB) Mod 1000
If Varnum > 0 Then
GoSub centaine_dizaine
résultat = résultat + " " + varlet
End If
résultat = LTrim(résultat)
varlet = Right$(résultat, 4)

'*** Traitement du "s" final pour vingt et cent et du "de" pour million
Select Case varlet
Case "cent"
If Len(résultat) > 5 Then
résultat = résultat + "s"
End If

Case "ingt"
If Len(résultat) > 5 Then
résultat = résultat + "s"
End If

Case "ingt"
If Len(résultat) = 5 Then
résultat = résultat
End If

Case "lion", "ions", "iard", "ards"
résultat = résultat + " de"
End Select

fintraitementdollars: '*** Etiquette de branchement pour le cas "zéro Euro"
'*** Indication du terme Euro
résultat = résultat + " dollar"
If NB >= 2 Then résultat = résultat + "s"

'*** Traitement des Cents
Varnum = Int((NB - Int(NB)) * 100 + 0.5) '*** On additionne 0,5
'*** afin de compenser
'*** les erreurs de calcul
'*** dues aux arrondis
If Varnum > 0 Then
GoSub centaine_dizaine
résultat = résultat + " et " + varlet + " cent"
If Varnum > 1 Then résultat = résultat + "s"
End If


'*** Conversion 1ère lettre en majuscule
résultat = UCase(Left(résultat, 1)) + Right(résultat, Len(résultat) - 1)
'*** renvoie du résultat de la fonction et fin de la fonction
dollarsEnLettres = résultat
Exit Function
dollarsEnLettres_Fin:
Exit Function
centaine_dizaine: '*** Sous-programme de conversion en lettres
'*** des centaines et dizaines
varlet = ""


'*** Traitement des centaines
If Varnum >= 100 Then
varlet = chiffre(Int(Varnum / 100))
Varnum = Varnum Mod 100
If varlet = "un" Then
varlet = "cent "
Else
varlet = varlet + " cent "
End If
End If

'*** Traitement des dizaines
If Varnum <= 19 Then '*** Cas où la dizaine est <20
If Varnum > 0 Then varlet = varlet + chiffre(Varnum)
Else '*** Autres cas
varnumD = Int(Varnum / 10) '*** chiffre des dizaines
varnumU = Varnum Mod 10 '*** chiffre des unités
Select Case varnumD '*** génération des dizaines en lettres
Case Is <= 5
varlet = varlet + dizaine(varnumD)
Case 0
varlet = varlet + dizaine(2)
Case 6, 7
varlet = varlet + dizaine(6)
Case 8, 9
varlet = varlet + dizaine(Cool
End Select
'*** traitement du séparateur des dizaines et unités
If varnumU = 1 And varnumD < 8 Then
varlet = varlet + " et "
Else
If varnumU <> 0 Or varnumD = 7 Or varnumD = 9 Then
varlet = varlet + "-"
End If
End If
'*** génération des unités
If varnumD = 7 Or varnumD = 9 Then varnumU = varnumU + 10
If varnumU <> 0 Then varlet = varlet + chiffre(varnumU)
End If
'*** Suppression des espaces à gauche et retour
varlet = RTrim(varlet)
Return
dollarsEnLettres_suite:
dollarsEnLettres = ""
Resume dollarsEnLettres_Fin
End Function
Function Arrondir(N As Variant, NBDECI As Integer) As Double
If IsNull(N) Then
Arrondir = 0
Exit Function
End If
Arrondir = Int((N * 10 ^ NBDECI) + 0.5) / (10 ^ NBDECI)
End Function
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
microsophistic



Nombre de messages : 2
Date d'inscription : 30/12/2012

MessageSujet: Conversion nombre en lettre   Lun 31 Déc - 6:04

Bonjour, voici le code revu qui fonctionne très bien sous access 2007 a insérer dans un module et dans un formulaire reste à créer deux champs texte un pour la conversion en lettre dont la "source contrôle" indique =EnLettresEuro([Nombre]) et un autre pour indiquer le nombre à convertir au "format" monétaire dont le "nom" sera Nombre.


Cordialement


'copier tout ce qui suit dans un module
Option Compare Database
Option Explicit
Function PMod(V As Variant, D) As Variant
Dim R As Variant
Dim M As Variant
R = Int(V / D)
M = R * D
PMod = V - M
End Function
Function EnLettresEuro(NB) As String
On Error GoTo EnLettresEuro_suite
Dim Varnum As Long
Dim varnumD, varnumU, varlet, résultat

'varnum : pour stocker les parties du nombre que l'on va découper
'varlet : pour stocker la conversion en lettres d'une partie du nombre
'varnumD : pour stocker la partie dizaine d'un nombre à 2 chiffres
'varnumU : pour stocker la partie unité d'un nombre à 2 chiffres
'résultat : pour stocker les résultats intermédiaires des différentes étapes

Static chiffre(1 To 19) '*** tableau contenant le nom des 19 premiers nombres en lettres
chiffre(1) = "un"
chiffre(2) = "deux"
chiffre(3) = "trois"
chiffre(4) = "quatre"
chiffre(5) = "cinq"
chiffre(6) = "six"
chiffre(7) = "sept"
chiffre(Cool = "huit"
chiffre(9) = "neuf"
chiffre(10) = "dix"
chiffre(11) = "onze"
chiffre(12) = "douze"
chiffre(13) = "treize"
chiffre(14) = "quatorze"
chiffre(15) = "quinze"
chiffre(16) = "seize"
chiffre(17) = "dix-sept"
chiffre(18) = "dix-huit"
chiffre(19) = "dix-neuf"
Static dizaine(1 To 19) '*** tableau contenant les noms des dizaines
dizaine(1) = "dix"
dizaine(2) = "vingt"
dizaine(3) = "trente"
dizaine(4) = "quarante"
dizaine(5) = "cinquante"
dizaine(6) = "soixante"
dizaine(Cool = "quatre-vingt"

'*** Traitement du cas zéro Euro
If NB >= 1 Then
résultat = ""
Else
résultat = "zéro"
GoTo fintraitement
End If

'*** Traitement des milliards
Varnum = Int(NB / 1000000000)
If Varnum > 0 Then
GoSub centaine_dizaine
résultat = varlet + " milliard"
If varlet <> "un" Then résultat = résultat + "s"
End If

'*** Traitement des millions
Varnum = Int(PMod(NB, 1000000000)) 'Int(NB) Mod 1000000000
Varnum = Int(Varnum / 1000000)
If Varnum > 0 Then
GoSub centaine_dizaine
résultat = résultat + " " + varlet + " million"
If varlet <> "un" Then résultat = résultat + "s"
End If

'*** Traitement des milliers
Varnum = Int(PMod(NB, 1000000))
Varnum = Int(Varnum / 1000)
If Varnum > 0 Then
GoSub centaine_dizaine
If varlet <> "un" Then résultat = résultat + " " + varlet
résultat = résultat + " mille"
End If

'*** Traitement des centaines et dizaines
Varnum = Int(PMod(NB, 1000)) 'Int(NB) Mod 1000
If Varnum > 0 Then
GoSub centaine_dizaine
résultat = résultat + " " + varlet
End If
résultat = LTrim(résultat)
varlet = Right$(résultat, 4)

'traitement du "s" final pour quatre-vingt et cent et du "de" pour million et milliard
résultat = LTrim(résultat)
varlet = Right$(résultat, 5)
Select Case varlet
Case " cent"
résultat = résultat + "s"
Case "llion", "lions"
résultat = résultat + " de"
Case "liard", "iards"
résultat = résultat + " de"
End Select

résultat = LTrim(résultat)
varlet = Right$(résultat, 12)
Select Case varlet
Case "quatre-vingt"
résultat = résultat + "s"
End Select

fintraitement: '*** Etiquette de branchement pour le cas "zéro Euro"

'*** Indication du terme Euro
résultat = résultat + " euro"
If NB >= 2 Then résultat = résultat + "s"

'*** Traitement des Centimes
Varnum = Int((NB - Int(NB)) * 100 + 0.5) '*** On additionne 0,5 afin de compenser les erreurs de calcul dues aux arrondis
If Varnum > 0 Then
GoSub centaine_dizaine
résultat = résultat + " et " + varlet + " centime"
If Varnum > 1 Then résultat = résultat + "s"
End If

'*** Conversion 1ère lettre en majuscule et mise entre parenthèses du Résultat final
résultat = "( " + UCase(Left(résultat, 1)) + Right(résultat, Len(résultat) - 1) + " )"


'*** renvoie du résultat de la fonction et fin de la fonction
EnLettresEuro = résultat
Exit Function
EnLettresEuro_Fin:
Exit Function
centaine_dizaine: '*** Sous-programme de conversion en lettres
'*** des centaines et dizaines
varlet = ""


'*** Traitement des centaines
If Varnum >= 100 Then
varlet = chiffre(Int(Varnum / 100))
Varnum = Varnum Mod 100
If varlet = "un" Then
varlet = "cent "
Else
varlet = varlet + " cent "
End If
End If

'*** Traitement des dizaines
If Varnum <= 19 Then '*** Cas où la dizaine est <20
If Varnum > 0 Then varlet = varlet + chiffre(Varnum)
Else '*** Autres cas
varnumD = Int(Varnum / 10) '*** chiffre des dizaines
varnumU = Varnum Mod 10 '*** chiffre des unités
Select Case varnumD '*** génération des dizaines en lettres
Case Is <= 5
varlet = varlet + dizaine(varnumD)
Case 0
varlet = varlet + dizaine(2)
Case 6, 7
varlet = varlet + dizaine(6)
Case 8, 9
varlet = varlet + dizaine(Cool
End Select

'*** traitement du séparateur des dizaines et unités
If varnumU = 1 And varnumD < 8 Then
varlet = varlet + " et "
Else
If varnumU <> 0 Or varnumD = 7 Or varnumD = 9 Then
varlet = varlet + "-"
End If
End If

'*** génération des unités
If varnumD = 7 Or varnumD = 9 Then varnumU = varnumU + 10
If varnumU <> 0 Then varlet = varlet + chiffre(varnumU)
End If

'*** Suppression des espaces à gauche et retour
varlet = RTrim(varlet)
Return
EnLettresEuro_suite:
EnLettresEuro = ""
Resume EnLettresEuro_Fin
End Function

Revenir en haut Aller en bas
Voir le profil de l'utilisateur
microsophistic



Nombre de messages : 2
Date d'inscription : 30/12/2012

MessageSujet: Petit souci d'affichage...   Lun 31 Déc - 6:08

Il y a un problème avec le chiffre 8 et la parenthèse qui sont remplacées par un smileys dont reste à voir ce Pb ...o;
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Contenu sponsorisé




MessageSujet: Re: Calcul de chiffre en lettre , besoin d aide   

Revenir en haut Aller en bas
 
Calcul de chiffre en lettre , besoin d aide
Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» Besoin d'aide pour le Déménagement
» Besoin d'aide pour description avec Html et css (j'espere que je me suis bien exprimé...)
» Besoin d'aide pour arranger le profil
» Besoin d'aide pour liens dans tableau
» Besoin d'aide pour problème de plagiat

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
Les Trucs & Astuces Informatiques de Michel :: Boîtes à Idées-
Sauter vers: