Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Excel > Contribuez
Contribuez Placez ici vos codes, sources, trucs et astuces que vous souhaitez partager avec les membres du club.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
'
Vieux 10/11/2011, 12h47   #1
Membre habitué
 
pascal
artisan poseur
Inscription : octobre 2006
Messages : 342
Détails du profil
Informations personnelles :
Nom : pascal

Informations professionnelles :
Activité : artisan poseur
Secteur : Bâtiment

Informations forums :
Inscription : octobre 2006
Messages : 342
Points : 137
Points : 137
Par défaut chiffres(monétaire) en lettres

bonjour a tous
avec plusieurs demande sur le forum voici un code a mettre dans un module standard afin de mettre le chiffre(monétaire) en toutes lettres dans la cellule de votre choix sous réserve d'y mettre =chiffrelettre(L32), (L32) étant une cellule fictive
Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Function chiffrelettre(s)
Dim A As Variant, gros As Variant
A = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix sept", _
"dix huit", "dix neuf", "vingt", "vingt et un", "vingt deux", "vingt trois", "vingt quatre", _
"vingt cinq", "vingt six", "vingt sept", "vingt huit", "vingt neuf", "trente", "trente et un", _
"trente deux", "trente trois", "trente quatre", "trente cinq", "trente six", "trente sept", _
"trente huit", "trente neuf", "quarante", "quarante et un", "quarante deux", "quarante trois", _
"quarante quatre", "quarante cinq", "quarante six", "quarante sept", "quarante huit", _
"quarante neuf", "cinquante", "cinquante et un", "cinquante deux", "cinquante trois", _
"cinquante quatre", "cinquante cinq", "cinquante six", "cinquante sept", "cinquante huit", _
"cinquante neuf", "soixante", "soixante et un", "soixante deux", "soixante trois", _
"soixante quatre", "soixante cinq", "soixante six", "soixante sept", "soixante huit", _
"soixante neuf", "soixante dix", "soixante et onze", "soixante douze", "soixante treize", _
"soixante quatorze", "soixante quinze", "soixante seize", "soixante dix sept", _
"soixante dix huit", "soixante dix neuf", "quatre-vingts", "quatre-vingt un", _
"quatre-vingt deux", "quatre-vingt trois", "quatre-vingt quatre", "quatre-vingt cinq", _
"quatre-vingt six", "quatre-vingt sept", "quatre-vingt huit", "quatre-vingt neuf", _
"quatre-vingt dix", "quatre-vingt onze", "quatre-vingt douze", "quatre-vingt treize", _
"quatre-vingt quatorze", "quatre-vingt quinze", "quatre-vingt seize", "quatre-vingt dix sept", _
"quatre-vingt dix huit", "quatre-vingt dix neuf")
gros = Array("", "billions", "milliards", "millions", "mille", "EUROS", "billion", _
"milliard", "million", "mille", "EURO")
sp = Space(1)
chaine = "00000000000000"
centime = s * 100 - (Int(s) * 100)
s = Str(Int(s)): lg = Len(s) - 1: s = Right(s, lg): lg = Len(s)
If lg < 15 Then chaine = Mid(chaine, 1, (15 - lg)) Else chaine = ""
s = chaine + s
'billions au centaines
gp = 1
For k = 1 To 5
X = Mid(s, gp, 1): C = A(Val(X))
X = Mid(s, gp + 1, 2): d = A(Val(X))
If k = 5 Then
If t2 <> "" And C & d = "" Then mydz = "Euros" & sp: GoTo fin
If T <> "" And C = "" And d = "un" Then mydz = "un euros" & sp: GoTo fin
If T <> "" And t2 = "" And C & d = "" Then mydz = "d'Euros" & sp: GoTo fin
If T & C & d = "" Then myct = "": mydz = "": GoTo fin
End If
If C & d = "" Then GoTo fin
If d = "" And C <> "" And C <> "un" Then mydz = C & sp & "cents " & gros(k) & sp: GoTo fin
If d = "" And C = "un" Then mydz = "cent " & gros(k) & sp: GoTo fin
If d = "un" And C = "" Then myct = IIf(k = 4, gros(k) & sp, "un " & gros(k + 5) & sp): GoTo fin
If d <> "" And C = "un" Then mydz = "cent" & sp
If d <> "" And C <> "" And C <> "un" Then mydz = C & sp & "cent" + sp
myct = d & sp & gros(k) & sp
fin:
t2 = mydz & myct
T = T & mydz & myct
mydz = "": myct = ""
gp = gp + 3
Next
d = A(centime)
If T <> "" Then myct = IIf(centime = 1, " centime", " CENTS")
If T = "" Then myct = IIf(centime = 1, " centime d'Euro", " centimes d'Euro")
If centime = 0 Then d = "": myct = ""
chiffrelettre = T & d & myct
End Function
cordialement a tous

Pascal
grisan29 est déconnecté   Envoyer un message privé Réponse avec citation 10
Vieux 11/11/2011, 10h34   #2
Membre émérite
 
Avatar de Vadorblanc
 
Homme
Inscription : février 2008
Messages : 266
Détails du profil
Informations personnelles :
Sexe : Homme
Âge : 56
Localisation : France

Informations forums :
Inscription : février 2008
Messages : 266
Points : 873
Points : 873
Bonjour
Je trouve super ce code, reste à corriger la faute de Français pour le "cent", car devant mille, cent reste invariable, mais s'accorde devant millier, million, milliard.
Je vais utiliser ce code qui est très interessant et qui fonctionne très facilement.
Un grand merci.
__________________
! Quand tu es arrivé au sommet de la montagne, continue de grimper !
Vadorblanc est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 11/11/2011, 16h56   #3
Membre habitué
 
pascal
artisan poseur
Inscription : octobre 2006
Messages : 342
Détails du profil
Informations personnelles :
Nom : pascal

Informations professionnelles :
Activité : artisan poseur
Secteur : Bâtiment

Informations forums :
Inscription : octobre 2006
Messages : 342
Points : 137
Points : 137
bonjour vadorblanc
merci de me faire le remarque car je n'y ai pas pensé du tout , sur mon fichier après essai "cent" est toujours au pluriel?
ta remarque est judicieuse et j'y ai fait la modif a la ligne
Code :
If T <> "" Then myct = IIf(centime = 1, " centime", " CENT")
et a toutes les sommes j'ai "cent" au singulier
je ne sais pas sur quel ligne il faut agir pour arrivé a ta remarque
ce code n'étant pas de mon cru

merci

Pascal
grisan29 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 11/11/2011, 20h43   #4
Expert Confirmé
 
Avatar de patricktoulon
 
patrick
Inscription : avril 2009
Messages : 1 829
Détails du profil
Informations personnelles :
Nom : patrick
Âge : 42
Localisation : France, Var (Provence Alpes Côte d'Azur)

Informations professionnelles :
Secteur : Bâtiment

Informations forums :
Inscription : avril 2009
Messages : 1 829
Points : 2 857
Points : 2 857
Envoyer un message via MSN à patricktoulon
Par défaut re

bonjour grizan

il n'y a que 2 "cents" avec un "s" il te sera facile de trouver le bon


au plaisir
__________________
mes fichiers dans les contributions:
mon formulaire mail avec CDO en vba et mon formulaire mail avec CDO en vbs dans un HTA
mon nouveau mouse in out pour les boutons dans un userform
mon addin pour prendre un cliché de selection de cellules

si ton problème est résolu n'oublie pas de pointer :résolu:ça peut servir aux autres
et n'oublie pas de voter
patricktoulon est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 11/11/2011, 21h26   #5
Membre habitué
 
pascal
artisan poseur
Inscription : octobre 2006
Messages : 342
Détails du profil
Informations personnelles :
Nom : pascal

Informations professionnelles :
Activité : artisan poseur
Secteur : Bâtiment

Informations forums :
Inscription : octobre 2006
Messages : 342
Points : 137
Points : 137
bonsoir Patrick
dans la version tordue de mon fichier ce code fonctionnait bien avant d'avoir poster le code en fait il y a 3 "cent" dont 1 écrit en grand (par moi)
je ne peux plus faire évolué le fichier a modules car je bloque et je ne veux pas en faire une usine a gaz comme l'autre, j'attendrais patiemment ta 1ere mouture
cordialement

pascal
grisan29 est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité
Outils de la discussion



Fuseau horaire GMT +2. Il est actuellement 06h30.


 
 
 
 
Partenaires

Hébergement Web