Comment écrire la date en lettre [Résolu]

Signaler
Messages postés
20
Date d'inscription
mercredi 10 octobre 2007
Statut
Membre
Dernière intervention
10 juillet 2011
-
Messages postés
1566
Date d'inscription
mardi 26 décembre 2000
Statut
Membre
Dernière intervention
5 avril 2013
-
salut
j'ai un petite problème en vb6
 
Comment peut écrire la date en lettre ex: text1.text date par ex: la date 2/12/2009  ce format Deux décembre Année Deux mille neufé
merci

10 réponses

Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
70
Salut
Pour les dates, des fonctions existent déjà dans le langage pour :
- récupérer le nom du jour de la date en toutes lettres (lundi ... dimanche)
- récupérer le nom du mois de la date en toutes lettres (janvier ... décembre)
--> Voir la fonction Format

En fait, ton problème est de convertir des chiffres pour le n° du jour et pour l'année.
Pour cela, rien de plus simple : Tu tapes "chiffres en lettres" dans la case Rechercher parmi les Codes en excluant .NET et tu auras des exemples.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

<hr />Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
Messages postés
1566
Date d'inscription
mardi 26 décembre 2000
Statut
Membre
Dernière intervention
5 avril 2013
4
Voilà ce que je te propose, moh120...

J'ai bâclé et ne peaufinerai pas avant que tu aies fait des tests (pour relever d'éventuels bugs)...

Pour tes essais : une textbox Text1 (où tu t'efforceras, cela va de soi, d'éviter de saisir des dates non valides, hein ...)

Voilà le 1er jus, donc :

Private Sub Command1_Click()
  Dim ladate As Date
  ladate = Text1.Text
  MsgBox datelet(ladate)
End Sub





Private Function datelet(ladate As Date) As String
  unites = Array("", "un", "deux", "trois", "quatre", "cing", "six", "sept", "huit", "neuf")
  dizaines = Array("", "dix", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix")
  bizarre = Array("", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dis-huit", "dis-neuf")
  If Day(ladate) < 10 Then    jour IIf(unites(Day(ladate)) "un", "premier", unites(Day(ladate)))
  ElseIf Day(ladate) < 20 Then
    jour = bizarre(Day(ladate) - 10)
  Else
    jour = dizaines(Day(ladate) \ 10)
    Select Case Day(ladate) Mod 10
      Case 1
        jour = jour & "-et-" & unites(Day(ladate) Mod 10)
      Case Is > 1
        jour = jour & "-" & unites(Day(ladate) Mod 10)
    End Select
  End If
  mois = Format(ladate, "mmmm")
  datelet = jour & " " & mois
  atrad = Year(ladate) \ 1000  If atrad > 0 Then datelet datelet & " " & IIf(unites(atrad) "un", "mil", unites(atrad) & " mille")
  atrad = (Year(ladate) Mod 1000) \ 100  If atrad > 0 Then datelet datelet & " " & IIf(unites(atrad) "un", "cent", unites(atrad) & " cent")
  atrad = (Format(ladate, "yy") \ 10)
  atradu = Format(ladate, "yy") Mod 10
  If atradu > 0 Then
    Select Case atrad
      Case 1, 7, 9       If atrad 2 Then titi "-" Else titi = ""       If atrad 7 And atradu 1 Then toto = "-et" Else toto = ""       atrad atrad - 1: atraduc titi & toto & "-" & bizarre(atradu)
      Case 0
        atraduc = "-" & unites(atradu)
      Case Else         atraduc IIf(atradu 1, "", "-") & unites(atradu)
    End Select
  End If
  If atrad > 0 Then datelet = datelet & " " & dizaines(atrad)
  If atradu <> "" Then datelet = datelet & titi & atraduc
End Function
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
70
@ jmf0
C'est sûr, 1980 ne s'écrira jamais "mille quatre cent quatre-vingts" ... remarque, ce sont les soldes en ce moment, c'est peut être la raison du lapsus dactylograpique.
Mais bon, s'il n'y a que les "s" à supprimer, il peut paufiner le résultat.
Ce n'est pas un service que de leur fournir tout cuit ...

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

<hr />Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
Messages postés
1566
Date d'inscription
mardi 26 décembre 2000
Statut
Membre
Dernière intervention
5 avril 2013
4
Re,

Le "tout cuit" n'a été pour moi que l'occasion de m'exercer un peu de mon côté (sinon je rouille, moi aussi... et la rouille est mon principal ennemi, à mon âge...)...
Il faudra également faire attention aux Mil (de mil neuf cent, par exemple) à distinguer des Mille (de deux mille douze, par exemple), et à d'autre "petites choses"... qui peuvent troubler.
Messages postés
1566
Date d'inscription
mardi 26 décembre 2000
Statut
Membre
Dernière intervention
5 avril 2013
4
Bon..


Un bug à corriger et une rationalisation à mettre en oeuvre.


Le tout est en cours et sera fini après déjeuner.


A +
Messages postés
1566
Date d'inscription
mardi 26 décembre 2000
Statut
Membre
Dernière intervention
5 avril 2013
4
Voilà donc, après correction et rationalisation :

Option Explicit
Private Sub Command1_Click()
  Dim ladate As Date
  ladate = Text1.Text
  MsgBox Datlet(ladate)
End Sub



Private Function Datlet(ladate As Date) As String
  Datlet = XT(Day(ladate), "J") & " " & Format(ladate, "mmmm") & XT(Year(ladate), "coucou") & " " & XT(Format(ladate, "yy"), "A")  If Left(Datlet, 1) "-" Then Datlet Mid(Datlet, 2)
End Function



Private Function XT(Q As Integer, M As String) As String
  Dim U, D, Exc
  U = Array("", "un", "deux", "trois", "quatre", "cing", "six", "sept", "huit", "neuf")
  D = Array("", "dix", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix")
  Exc = Array("", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dis-neuf")
  Dim A As Integer, Au As Integer, Auc As String, ET As String  If M "J" Or M "A" Then    A Q \ 10: Au Q Mod 10
    If Au > 0 Then
      Select Case A
        Case 1, 7, 9          If A 7 And Au 1 Then ET = "-et" Else ET = ""          A A - 1: Auc ET & "-" & Exc(Au)
        Case Else          If M "A" Or (M "J" And A > 0) Then            Auc IIf(Au 1 And A > 0, "-et-", "-") & U(Au)
          Else            Auc IIf(Au 1, "premier", U(Au))
          End If
      End Select
    End If
    If A > 0 Then XT = XT & " " & D(A)
    XT = XT & Auc
  Else
    A = Q \ 1000    If A > 0 Then XT " " & IIf(U(A) "un", "mil", U(A) & " mille")
    A = (Q Mod 1000) \ 100    If A > 0 Then XT XT & " " & IIf(U(A) "un", "cent", U(A) & " cent")
  End If
End Function





J'en ai marre de "gratter", d'essayer avec plusieurs dates et tous les cas de figure, etc... pour rechercher une imperfection éventuelle qui aurtait pu m'échapper  ici ou là ...
peux-tu le faire pour moi, moh120 ?
Ce n'est qu'après confirmation de ce que tou va bien que je pourrai penser à en faire éventuellement un snippet, dans la mesure ou ce traitement est plus court que celui de l'utilisation de ce qui existe pour transformer des nombres (autres que dates) en lettres, d'une part, et que, d'autre part, il respecte la syntaxe particulière des dates.
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
70
Pas testé, mais beau boulot !

Moh120 : N'oublie pas de valider la réponse de Jfm0, en guise de remerciement (bouton "Réponse acceptée!")
Messages postés
20
Date d'inscription
mercredi 10 octobre 2007
Statut
Membre
Dernière intervention
10 juillet 2011

merci pour la réponse
Messages postés
1566
Date d'inscription
mardi 26 décembre 2000
Statut
Membre
Dernière intervention
5 avril 2013
4
Bonjour Jack

Pas vraiment d'accord car la syntaxe des dates ne correspond pas à celle des nombres
1980 , par exemple, ne saurait s'écrire mille quatre cent quatre-vingts (comme s'écrirait 1980 carambars) et 2200 ne s'écrirait pas deux mille deux cents, etc...
Bon... je vais jouer un peu avec ces dates et revenir ( 1/2 à peu près ?)...
Messages postés
1566
Date d'inscription
mardi 26 décembre 2000
Statut
Membre
Dernière intervention
5 avril 2013
4
Ah !!!
Merci ?
Et pas réponse acceptée ?
Tiens...
Aucune importance de toutes manières car :
1) j'ai depuis trouvé une petite imperfection, que j'ai corrigée
2) je me suis lancé dans du un peu plus compliqué (traduction en lettres en 3 langues, et dieu sait si l'anglais et l'espagnol sont encore plus complexes, dance ce domaine de l'expression des dates en toutes lettres !). Et en 3 styles ( 2 "classiques" et 1 "notaire")
3) j'ai presque terminé et déposerai une source ... pour que les autres puissent en profiter également.

Il te reste donc à attendre, maintenant (comme chacun) le dépôt de ma source Ce sera fait, en ce qui me concerne, avant les 8 jours que tu as toi-même pris à répondre (je ne serai pas plus royaliste que le roi !)