Représentation du jour de la date en lettre ?????(résolu )

ILOVEUBB

XLDnaute Occasionnel
BONSOIR TOUS LE MONDES !

voila je cherche a convertir le jour de la date actuel en lettre ,j'ai réussi a trouver la macro qui permet la représentation des chiffre en lettre grâce au membre , mais comme la date et stocke en forme de n° de série dans la cellule , la représentation ne marche pas .
une idée svp !?
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Représentation du jour de la date en lettre ?????

Bonjour ILOVEUBB, camarchepas,

viola je cherche a convertir le jour de la date actuel en lettre ,j'ai réussi a trouver la macro qui permet la représentation des chiffre en lettre grâce au membre , mais comme la date et stocke en forme de n° de série dans la cellule , la représentation ne marche pas .
une idée svp !?

Puisque vous avez la macro de conversion, ce n'est pas la date x qu'il faut convertir mais le jour renvoyé par Day(x).

Et à la fin vous pouvez concatener avec le nom du jour Format(x, "dddd"), du mois Format(x, "mmmm") etc...

Edit : salut Pierrot, pas vu.

A+
 
Dernière édition:

ILOVEUBB

XLDnaute Occasionnel
Re : Représentation du jour de la date en lettre ?????

BONSOIR Pierrot93,camarchepas ,job75

merci pour votre réponse .
je pense que je n'étais pas assez claire ,
exp :
date :16/03/2015 qui est la date courante A1=aujourdhui()
représentation : le seize mars deux mille quinze ,
voila le resulta que je cherche mais il m'affiche 42079

le code de la macro :
Option Explicit
Function NumText(Nombre As Currency, Optional Unité As String, Optional no_chiffres As Integer, Optional SousUnité As String) As String
Dim PartieEntière As Currency, PartieDécimal As Currency
Dim TxtEntier As String, TxtDécimal As String
PartieEntière = Int(Nombre)
TxtEntier = NumTextEntier(PartieEntière)
If no_chiffres > 0 Then
PartieDécimal = (Nombre - PartieEntière) * 10 ^ no_chiffres
TxtDécimal = Format(PartieDécimal, String(no_chiffres, "0"))
End If
NumText = TxtEntier & Unité & " " & TxtDécimal & " " & SousUnité
End Function

Function NumTextEntier(ByVal Entier As Currency) As String
Dim no_Classe As Integer, Classe As Integer
If Entier = 0 Then
NumTextEntier = "zéro "
Else
While Entier > 0
Classe = Entier - Int(Entier / 1000) * 1000
NumTextEntier = TxtClasse(Classe, no_Classe) & NumTextEntier
no_Classe = no_Classe + 1
Entier = Int(Entier / 1000)
Wend
End If
End Function

Function TxtClasse(Classe As Integer, no_Classe As Integer) As String
Dim Centaine As Integer, Dizaine As Integer, Unité As Integer, Unités2Chiffres As Integer
Dim TxtCentaines As String, TxtDizaines As String, TxtUnités As String
Dim TClasses As Variant, Tdizaines As Variant, TUnités As Variant
TClasses = Array("", "Mille", "Million", "Milliard", "Billion")
Tdizaines = Array("", "", "Vingt", "Trente", "Quarante", "Cinquante", "Soixante", "Soixante", "Quatre-Vingt", "Quatre-Vingt")
TUnités = Array("", "Un", "Deux", "Trois", "Quatre", "Cinq", "Six", "Sept", "Huit", "Neuf", _
"Dix", "Onze", "Douze", "Treize", "Quatorze", "Quinze", "Seize", "Dix-Sept", "Dix-Huit", "Dix-Neuf")
If Classe = 0 Then Exit Function
' Pas de un pour mille
If Classe = 1 And no_Classe = 1 Then
TxtClasse = "mille "
Exit Function
End If
'
Centaine = Classe \ 100
Unités2Chiffres = Classe Mod 100
Dizaine = Unités2Chiffres \ 10
Unité = Unités2Chiffres Mod 10
' Les centaines -----
If Centaine = 1 Then
TxtCentaines = "cent "
ElseIf Centaine > 1 Then
TxtCentaines = TUnités(Centaine) & " cent" & IIf(Unités2Chiffres > 0, " ", "s ")
End If
' Les dizaines ------
TxtDizaines = Tdizaines(Dizaine)
If Unité = 1 And Dizaine > 1 And Dizaine < 8 Then
TxtDizaines = TxtDizaines & "-et"
End If
If Dizaine = 1 Or Dizaine = 7 Or Dizaine = 9 Then
Unité = Unité + 10: Dizaine = 0
End If
TxtDizaines = TxtDizaines & IIf(Unités2Chiffres = 80, "s", "")
If Unités2Chiffres > 19 And Unité > 0 Then
TxtDizaines = TxtDizaines & "-"
ElseIf Dizaine > 0 Then
TxtDizaines = TxtDizaines & " "
End If
' Les unités -------- Espace si unité > 0
TxtUnités = TUnités(Unité) & IIf(Unité > 0, " ", "")
' La classe --------- un s sauf pour mille
TxtClasse = TClasses(no_Classe) & IIf(no_Classe > 1 And Classe > 1, "s", "") & IIf(no_Classe > 0, " ", "")
' Résultat ----------
TxtClasse = TxtCentaines & TxtDizaines & TxtUnités & TxtClasse
End Function
 
Dernière édition:

Modeste geedee

XLDnaute Barbatruc
Re : Représentation du jour de la date en lettre ?????

Bonsour®
Date en Texte ???
=AUJOURDHUI() =dateenlettres(A1)
16/03/2015 seize mars deux mille quinze

VB:
 Function DateEnLettres(ladate As Date) As String
 Dim verif As String
 verif = Application.Trim( _
  EnTexte(Day(ladate), 2) _
  & " " & Format(ladate, "mmmm") _
  & " " & EnTexte(Format(ladate, "yyyy"), 4) _
  & " " & EnTexte(Format(ladate, "yy"), 2))
  If Right(verif, 7) = "premier" Then verif = Left(verif, Len(verif) - 7) & "un"
  DateEnLettres = verif
End Function
VB:
Function EnTexte(Valeur As Integer, NbPos As Integer) As String
  Dim U, D, V, Exc
  Dim JJ As Integer, Unite As Integer, Dizaine As Integer
  U = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf")
  D = Array("", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf")
  V = Array("", "dix", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante", "quatre-vingt", "quatre-vingt")
  Exc = Array("", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf")
  Dim A As Integer, Au As Integer, Auc As String, ET As String
 
 Unite = Valeur Mod 10
 Dizaine = Int(Valeur / 10)
  Select Case NbPos
        Case 2
                Select Case Dizaine
                        Case 0
                            EnTexte = IIf(Valeur = 1, "premier", IIf(Unite = 0, "", U(Valeur)))
                        Case 1
                            EnTexte = D(1 + Unite)
                        Case 2, 3, 4, 5, 6
                             EnTexte = V(Dizaine) & IIf(Unite > 1, "-", IIf(Unite = 0, "", " et ")) & U(Unite)
                        Case 8
                             EnTexte = V(Dizaine) & IIf(Unite = 0, "", "-") & U(Unite)
                       Case 7, 9
                             EnTexte = V(Dizaine) & IIf(Unite = 0, "dix", IIf(Unite = 1, " et ", "-") & Exc(Unite))
                       Case Else
                End Select
        Case 4
           A = Valeur \ 1000
           If A > 0 Then EnTexte = " " & IIf(U(A) = "un", "mil", U(A) & " mille")
           A = (Valeur Mod 1000) \ 100
           If A > 0 Then EnTexte = EnTexte & " " & IIf(U(A) = "un", "cent", U(A) & " cent")
        Case Else
 End Select
End Function
 

ILOVEUBB

XLDnaute Occasionnel
Re : Représentation du jour de la date en lettre ?????

BONSOIR Pierrot93,camarchepas ,job75

merci pour votre réponse .
je pense que je n'étais pas assez claire ,
exp :
date :16/03/2015 qui est la date courante A1=aujourdhui()
représentation : le seize mars deux mille quinze ,
voila le resulta que je cherche mais il m'affiche 42079

le code de la macro :
Option Explicit
Function NumText(Nombre As Currency, Optional Unité As String, Optional no_chiffres As Integer, Optional SousUnité As String) As String
Dim PartieEntière As Currency, PartieDécimal As Currency
Dim TxtEntier As String, TxtDécimal As String
PartieEntière = Int(Nombre)
TxtEntier = NumTextEntier(PartieEntière)
If no_chiffres > 0 Then
PartieDécimal = (Nombre - PartieEntière) * 10 ^ no_chiffres
TxtDécimal = Format(PartieDécimal, String(no_chiffres, "0"))
End If
NumText = TxtEntier & Unité & " " & TxtDécimal & " " & SousUnité
End Function

Function NumTextEntier(ByVal Entier As Currency) As String
Dim no_Classe As Integer, Classe As Integer
If Entier = 0 Then
NumTextEntier = "zéro "
Else
While Entier > 0
Classe = Entier - Int(Entier / 1000) * 1000
NumTextEntier = TxtClasse(Classe, no_Classe) & NumTextEntier
no_Classe = no_Classe + 1
Entier = Int(Entier / 1000)
Wend
End If
End Function

Function TxtClasse(Classe As Integer, no_Classe As Integer) As String
Dim Centaine As Integer, Dizaine As Integer, Unité As Integer, Unités2Chiffres As Integer
Dim TxtCentaines As String, TxtDizaines As String, TxtUnités As String
Dim TClasses As Variant, Tdizaines As Variant, TUnités As Variant
TClasses = Array("", "Mille", "Million", "Milliard", "Billion")
Tdizaines = Array("", "", "Vingt", "Trente", "Quarante", "Cinquante", "Soixante", "Soixante", "Quatre-Vingt", "Quatre-Vingt")
TUnités = Array("", "Un", "Deux", "Trois", "Quatre", "Cinq", "Six", "Sept", "Huit", "Neuf", _
"Dix", "Onze", "Douze", "Treize", "Quatorze", "Quinze", "Seize", "Dix-Sept", "Dix-Huit", "Dix-Neuf")
If Classe = 0 Then Exit Function
' Pas de un pour mille
If Classe = 1 And no_Classe = 1 Then
TxtClasse = "mille "
Exit Function
End If
'
Centaine = Classe \ 100
Unités2Chiffres = Classe Mod 100
Dizaine = Unités2Chiffres \ 10
Unité = Unités2Chiffres Mod 10
' Les centaines -----
If Centaine = 1 Then
TxtCentaines = "cent "
ElseIf Centaine > 1 Then
TxtCentaines = TUnités(Centaine) & " cent" & IIf(Unités2Chiffres > 0, " ", "s ")
End If
' Les dizaines ------
TxtDizaines = Tdizaines(Dizaine)
If Unité = 1 And Dizaine > 1 And Dizaine < 8 Then
TxtDizaines = TxtDizaines & "-et"
End If
If Dizaine = 1 Or Dizaine = 7 Or Dizaine = 9 Then
Unité = Unité + 10: Dizaine = 0
End If
TxtDizaines = TxtDizaines & IIf(Unités2Chiffres = 80, "s", "")
If Unités2Chiffres > 19 And Unité > 0 Then
TxtDizaines = TxtDizaines & "-"
ElseIf Dizaine > 0 Then
TxtDizaines = TxtDizaines & " "
End If
' Les unités -------- Espace si unité > 0
TxtUnités = TUnités(Unité) & IIf(Unité > 0, " ", "")
' La classe --------- un s sauf pour mille
TxtClasse = TClasses(no_Classe) & IIf(no_Classe > 1 And Classe > 1, "s", "") & IIf(no_Classe > 0, " ", "")
' Résultat ----------
TxtClasse = TxtCentaines & TxtDizaines & TxtUnités & TxtClasse
End Function
 

job75

XLDnaute Barbatruc
Re : Représentation du jour de la date en lettre ?????

Re, hello Modeste geedee,

J'avais pourtant fourni les éléments, ça coule de source :

Code:
="le "&TEXTE(A2;"jjjj ")&MINUSCULE(SUPPRESPACE(NumText(JOUR(A2))&TEXTE(A2;"mmmm ")&NumText(ANNEE(A2))))
Fichier joint.

A+
 

Pièces jointes

  • Date texte(1).xlsm
    19.1 KB · Affichages: 33

job75

XLDnaute Barbatruc
Re : Représentation du jour de la date en lettre ?????(résolu )

Re,

Si l'on veut avoir "premier" le 1er jour du mois :

Code:
="le "&TEXTE(A2;"jjjj ")&MINUSCULE(SUPPRESPACE(SI(JOUR(A2)=1;"premier ";NumText(JOUR(A2)))&TEXTE(A2;"mmmm ")&NumText(ANNEE(A2))))
A+
 

Discussions similaires

Réponses
14
Affichages
490

Statistiques des forums

Discussions
311 720
Messages
2 081 907
Membres
101 836
dernier inscrit
karmon