Auteur : Tofalu
| Version : 08/10/2005 | | |
| |
Versions : Toutes
La médiane est la valeur qui se trouve au centre d'un ensemble de nombres.
En d'autres termes, les nombres appartenant à la première moitié de l'ensemble ont
une valeur inférieure à la médiane, tandis que ceux appartenant à l'autre moitié ont
une valeur supérieure à la médiane.
Exemple :
MEDIAN(1, 2, 3, 4, 5) égal 3
MEDIAN(1, 2, 3, 4, 5, 6) égal 3.5, moyenne de 3 et 4
Public Function fMediane(strTable As String, strField As String) As Variant
Dim oDBS As DAO.Database
Dim oRST As DAO.Recordset
Dim blnEven As Boolean
Dim vntMedian As Variant
Set oDBS = CurrentDb()
Set oRST = oDBS.OpenRecordset("SELECT * FROM " & strTable & " ORDER BY " & strField)
If oRST.EOF = False Then
oRST.MoveLast
blnEven = (oRST.RecordCount Mod 2 = 0)
oRST.PercentPosition = 50
vntMedian = oRST.Fields(strField)
If blnEven Then
oRST.MoveNext
vntMedian = (vntMedian + oRST.Fields(strField)) / 2
End If
End If
fMediane = vntMedian
oRST.Close
Set oRST = Nothing
Set oDBS = Nothing
End Function |
Test :
Sub TesterExemple()
MsgBox fMediane("TBLClients", "[Code client]")
End Sub |
|
| | Ce code permet de convertir des nombres en chiffres romains. La plage de conversion s'étend de 0 à 3999.
Dans un module : Function ChiffreRomain(ByVal Nombre As Integer) As String
Dim TNombre() As String
Dim i As Integer, Unite As Integer
If Nombre < 4000 Then
TNombre = Split("I,V,X,L,C,D,M", ",")
While Nombre > 0
Unite = Nombre Mod 10
Nombre = Nombre \ 10
Select Case Unite
Case 1 To 3
ChiffreRomain = String(Unite, TNombre(i)) & ChiffreRomain
Case 4
ChiffreRomain = TNombre(i) & TNombre(i + 1) & ChiffreRomain
Case 5 To 8
ChiffreRomain = TNombre(i + 1) & String(Unite - 5, _
TNombre(i)) & ChiffreRomain
Case 9
ChiffreRomain = TNombre(i) & TNombre(i + 2) & _
ChiffreRomain
End Select
i = i + 2
Wend
End If
End Function |
Utilisation : |
| |
Versions : Access 2000 et supérieures. Access 97 avec utilisation de la fonction Split issues des codes sources.
Pour convertir une chaine de caractères en nom propre (1ère lettre du mot en majuscule) il est possible d'utiliser l'expression suivante:
strLastName=StrConv(strLastName, vbProperCase) |
Cela marche très bien si peu que le prénom ou le nom est composé d'un seul mot.
En revanche, lorsqu'il y a une succession de mots séparés par un tiret ou un autre caractère,
ce n'est plus opérationel. Voici une petite fonction qui répond au problème.
Public Function GetProperName(ByVal TextToConvert As String) As String
Dim aSeparatorStrings() As String
Dim aSeparatorChar() As String
Dim aSeparatorsPos() As String
Dim aWords() As String
Dim sSeparators As String
Dim sTempChar As String
Dim sTempResult As String
Dim I As Integer
Dim S As Integer
Dim sSeparatorsPos As String
Dim iNBSeparators As Integer
Dim sLastChar As String
On Error GoTo L_ErrConversion
sSeparators = "| |;|:|-|~|@|_|&|*|#|'| "
aSeparatorStrings = Split(sSeparators, "|")
For I = 1 To Len(TextToConvert)
sTempChar = Mid(TextToConvert, I, 1)
For S = LBound(aSeparatorStrings) To UBound(aSeparatorStrings)
If sTempChar = aSeparatorStrings(S) Then
iNBSeparators = iNBSeparators + 1
ReDim Preserve aSeparatorChar(0 To iNBSeparators)
aSeparatorChar(iNBSeparators - 1) = sTempChar
sSeparatorsPos = sSeparatorsPos + Trim(str(I)) & ";"
Exit For
End If
Next
Next
If iNBSeparators = 0 Then
sTempResult = UCase(Left(TextToConvert, 1)) & LCase(Mid(TextToConvert, 2))
Else
sSeparatorsPos = IIf(Right(sSeparatorsPos, 1) = ";", Left(sSeparatorsPos, _
Len(sSeparatorsPos) - 1), sSeparatorsPos)
sSeparatorsPos = "1;" & sSeparatorsPos & ";" & Trim(str(Len(TextToConvert)))
I = 0: S = 0
aSeparatorsPos = Split(sSeparatorsPos, ";")
ReDim aWords(1 To iNBSeparators + 1)
For I = 1 To iNBSeparators + 1
sLastChar = IIf(I = (iNBSeparators + 1), vbNullString, aSeparatorChar(I - 1))
If I = 1 Then
aWords(I) = UCase(Mid(TextToConvert, 1, 1)) & LCase(Mid(TextToConvert, _
2, aSeparatorsPos(I) - 2)) & sLastChar
Else
S = IIf(I = (iNBSeparators + 1), 1, 2)
aWords(I) = UCase(Mid(TextToConvert, aSeparatorsPos(I - 1) + 1, 1)) & _
LCase(Mid(TextToConvert, aSeparatorsPos(I - 1) + 2, aSeparatorsPos(I) - _
aSeparatorsPos(I - 1) - S)) & sLastChar
End If
Next
For I = 1 To iNBSeparators + 1
sTempResult = sTempResult & aWords(I)
Next
End If
L_ExConversion:
GetProperName = sTempResult
Erase aSeparatorStrings
Erase aSeparatorChar
Erase aSeparatorsPos
Exit Function
L_ErrConversion:
MsgBox "Une erreur est survenue durant la conversion de la chaîne de caractère...", _
48, "Conversion échouée"
sTempResult = TextToConvert
Resume L_ExConversion
End Function |
Mode d'utilisation :
Debug.Print GetProperName("charles-henri de l'arbre aux mésanges bleues") |
Bien, c'est pas très commun comme nom de famille mais bon, cela retourne:
Charles-Henri De L'Arbre Aux Mésanges Bleues
Note :
Les caractères de séparation pris en compte sont:
L'espace, le point-virgule, les deux points, le tiret, le tilde, l'arobase,
le underscore, le symbole de concaténation, l'astérisque, le dièse, l'apostrophe et l'espace caché.
Vous pouvez modifier ce tableau à votre convenance.
|
| | Cette fonction convertit une date julienne (utilisée par les AS400) du type 105047 en 16/02/2005. Si une erreur se produit lors de la conversion, la fonction retourne la date : 30/12/1899. Function DateFromJulian(LaDate as string) as date
On error goto err
Dim Annee as integer
Dim Jour as integer
Dim Temp as date
Annee=1900+Cint(Left(Ladate,1))*100+Cint(mid(LaDate,2,2))
Temp=DateSerial(Annee,1,1)
Jour=Cint(Right(LaDate,3))
DateFromJulian=DateAdd("d",Jour-1,Temp)
err:
End function |
Utilisation dans une requête : SELECT DateFromJulian(MaDate) FROM MaTable |
Explications :
- Le premier chiffre de la date julienne correspond au siècle. 0 pour 1900, 1 pour 2000
- Les deux suivants, l'année dans le siècle.
- Enfin les trois derniers correspondent au numéro du jour dans l'année.
|
| | Versions : 2000 et supérieures Public Function njour(jour As VbDayOfWeek, date1 As Date, date2 As Date) As Integer
Dim d As Date
Dim i As Integer
If date1 > date2 Then
MsgBox "Impossible de calculer, date2 doit être supérieur à date1"
Else
i = Weekday(date1)
If i > jour Then
i = 7 - i + jour
Else
i = jour - i
End If
d = DateAdd("d", i, date1)
If d < date2 Then njour = njour + 1
njour = njour + DateDiff("d", d, date2) \ 7
End If
End Function |
|
| |
Ce module complet propose des fonctions afin d'extraire et mettre en forme le nom de rue d'une adresse. Cette mise en forme offre la possibilité de trier de manière alphabétique les noms des rues dans une requête, alimentant par exemple une zone liste modifiable dans un formulaire de saisie des adresses.
Il permet par exemple de transformer :
46 bis Rue de la Paix par Rue de la Paix ou bien Paix (Rue de la).
Dans un module placez le code suivant : Function fNomVoie(ByVal str As String) As String
Dim strMotsClés As String, strMotsSecondaires As String, _
strMot As String
If str = "" Then Exit Function
strMotsClés = Trim(str)
strMotsClés = fVoieSansNum(strMotsClés)
strMot = fPremierMot(strMotsClés)
Do Until fMotClé(strMot)
strMotsSecondaires = strMotsSecondaires & " " & strMot
strMotsClés = LTrim(Right(strMotsClés, Len(strMotsClés) - Len(strMot)))
strMot = fPremierMot(strMotsClés)
Loop
If Len(LTrim(strMotsSecondaires)) > 0 Then _
strMotsSecondaires = " (" & LTrim(strMotsSecondaires) & ")"
fNomVoie = strMotsClés & strMotsSecondaires
End Function
Function fPremierMot(str As String)
Dim lng As Long
Dim strMot As String
For lng = 1 To Len(str)
Select Case Mid(str, lng, 1)
Case " "
strMot = Left(str, lng - 1)
fPremierMot = strMot
Exit Function
Case "'"
strMot = Left(str, lng)
fPremierMot = strMot
Exit Function
End Select
Next lng
fPremierMot = str
End Function
Function fMotClé(str As String) As Boolean
Select Case str
Case "Rue", "Boulevard", "Avenue", "Chemin", "Passage", "Traverse", _
"Route", "Place", "Allée", "Allées", "Esplanade", "Quai", _
"-", "le", "la", "les", "l'", "du", "de", "des", "d'", _
fMotClé = False
Case Else
fMotClé = True
End Select
End Function
Function fVoieSansNum(ByVal Voie As String) As String
Dim str As String
Dim bte As Byte, bteFinNum As Byte
Voie = Replace(Voie, ",", "")
str = Left$(Voie, 1)
If Not IsNumeric(str) Then
fVoieSansNum = Voie
Else
bte = 1
Do
If IsNumeric(str) Then
bteFinNum = bte
Do
bte = bte + 1
str = Mid$(Voie, bte, 1)
Loop Until str <> " "
Else
Select Case str
Case "-", "&"
Do
bte = bte + 1
str = Mid$(Voie, bte, 1)
Loop While str = " "
If Not IsNumeric(str) Then
Exit Do
End If
Case "b"
If Mid$(Voie, bte, 3) = "bis" Then
Select Case Mid$(Voie, bte + 3, 1)
Case " "
bte = bte + 3
bteFinNum = bte
Do
bte = bte + 1
str = Mid$(Voie, bte, 1)
Loop While str = " "
Case "-", "&"
bte = bte + 3
str = Mid$(Voie, bte, 1)
Case Else
Exit Do
End Select
Else
Select Case Mid$(Voie, bte + 1, 1)
Case " "
bte = bte + 1
bteFinNum = bte
Do
bte = bte + 1
str = Mid$(Voie, bte, 1)
Loop While str = " "
Case "-", "&"
bte = bte + 1
str = Mid$(Voie, bte, 1)
Case Else
Exit Do
End Select
End If
Case Else
Exit Do
End Select
End If
Loop
fVoieSansNum = Trim$(Right$(Voie, Len(Voie) - bteFinNum))
End If
End Function |
Utilisation des fonctions : Msgbox fVoieSansNum("90-92 Rue Meynadier") |
Affiche : Rue Meynadier Msgbox fNomVoie("90-92 Rue Meynadier") |
Affiche : Meynadier (Rue)
Remarques : Select Case str
Case "Rue", "Boulevard", "Avenue", "Chemin", "Passage", "Traverse", _
"Route", "Place", "Allée", "Allées", "Esplanade", "Quai", _
"-", "le", "la", "les", "l'", "du", "de", "des", "d'", _
fMotClé = False
Case Else
fMotClé = True
End Select |
Vous pouvez compléter vous-même la fonction fMotClé en ajoutant dans le premier Case, des mots "non-clés" (c'est à dire à ne pas considérer comme des noms de voie).
Vous trouverez une base de données utilisant ces fonctions dans une requête et un formulaire dans le fichier zip téléchargeable.
|
| | Versions : 97 et supérieures
Voici une liste de fonctions mathématiques dérivées des fonctions disponibles dans Access telles que sinus,cosinus et tangente.
Fonction sécante : Public Function Secante(Valeur As Double) As Double
Secante = 1 / Cos(Valeur)
End Function |
Fonction cosécante : Public Function CoSecante(Valeur As Double) As Double
CoSecante = 1 / Sin(Valeur)
End Function |
Fonction cotangente : Public Function CoTangente(Valeur As Double) As Double
CoTangente = 1 / Tan(Valeur)
End Function |
Fonction arcsinus : Public Function ArcSinus(Valeur As Double) As Double
ArcSinus = Atn(Valeur / Sqr(-Valeur * Valeur + 1))
End Function |
Fonction arccosinus : Public Function ArcCosinus(Valeur As Double) As Double
ArcCosinus = Atn(-Valeur / Sqr(-Valeur * Valeur + 1)) + _
2 * Atn(1)
End Function |
Fonction arcsécante : Public Function ArcSecante(Valeur As Double) As Double
ArcSecante = Atn(Valeur / Sqr(Valeur * Valeur - 1)) + _
Sgn((Valeur) - 1) * (2 * Atn(1))
End Function |
Fonction arccosécante : Public Function ArcCoSecante(Valeur As Double) As Double
ArcCoSecante = Atn(Valeur / Sqr(Valeur * Valeur - 1)) + _
(Sgn(Valeur) - 1) * (2 * Atn(1))
End Function |
Fonction arccotangente : Public Function ArcCoTangente(Valeur As Double) As Double
ArcCoTangente = Atn(Valeur) + 2 * Atn(1)
End Function |
Fonction sinus hyperbolique : Public Function SinusHyperbolique(Valeur As Double) As Double
SinusHyperbolique = (Exp(Valeur) - Exp(-Valeur)) / 2
End Function |
Fonction cosinus hyperbolique : Public Function CosinusHyperbolique(Valeur As Double) As Double
CosinusHyperbolique = (Exp(Valeur) + Exp(-Valeur)) / 2
End Function |
Fonction tangente hyperbolique : Public Function TangenteHyperbolique(Valeur As Double) As Double
TangenteHyperbolique = (Exp(Valeur) - Exp(-Valeur)) / _
(Exp(Valeur) + Exp(-Valeur))
End Function |
Fonction sécante hyperbolique : Public Function SecanteHyperbolique(Valeur As Double) As Double
SecanteHyperbolique = 2 / (Exp(Valeur) + Exp(-Valeur))
End Function |
Fonction cosécante hyperbolique : Public Function CosecanteHyperbolique(Valeur As Double) As Double
CosecanteHyperbolique = 2 / (Exp(Valeur) - Exp(-Valeur))
End Function |
Fonction cotangente hyperbolique : Public Function CoTangenteHyperbolique(Valeur As Double) As Double
CoTangenteHyperbolique = (Exp(Valeur) + Exp(-Valeur)) / _
(Exp(Valeur) - Exp(-Valeur))
End Function |
Fonction arcsinus hyperbolique : Public Function ArcSinusHyperbolique(Valeur As Double) As Double
ArcSinusHyperbolique = Log(Valeur + Sqr(Valeur * Valeur + 1))
End Function |
Fonction arccosinus hyperbolique : Public Function ArcCosinusHyperbolique(Valeur As Double) As Double
ArcCosinusHyperbolique = Log(Valeur + Sqr(Valeur * Valeur - 1))
End Function |
Fonction arctangente hyperbolique : Public Function ArcTangenteHyperbolique(Valeur As Double) As Double
ArcTangenteHyperbolique = Log((1 + Valeur) / (1 - Valeur)) / 2
End Function |
Fonction arcsécante hyperbolique : Public Function ArcSecanteHyperbolique(Valeur As Double) As Double
ArcSecanteHyperbolique = Log((Sqr(-Valeur * Valeur + 1) + 1) / Valeur)
End Function |
Fonction arccosécante hyperbolique : Public Function ArcCosecanteHyperbolique(Valeur As Double) As Double
ArcCosecanteHyperbolique = Log((Sgn(Valeur) * _
Sqr(Valeur * Valeur + 1) + 1) / Valeur)
End Function |
Fonction arccotangente hyperbolique : Public Function ArcCoTangenteHyperbolique(Valeur As Double) As Double
ArcCoTangenteHyperbolique = Log((Valeur + 1) / (Valeur - 1)) / 2
End Function |
Fonction logarithme de base N : Public Function LogBaseN(Valeur As Double, BaseN) As Double
LogBaseN = Log(Valeur) / Log(BaseN)
End Function |
Vous pouvez télecharger l'ensemble de ses fonctions regroupées dans un fichier .bas en cliquant sur le lien : télechargez le zip.
|
Auteur : Papilou
| Version : 27/08/2004 | | |
| | Versions : 2000 et supérieures
Cette fonction permet de mettre la première lettre de chaque mot en majuscule. Cela peut être très utile pour les prénoms composés
Option Compare Database
Function MiseEnMajuscule(Chaine As String) As String
Dim nCar As Integer
Chaine = Trim$(Chaine)
MiseEnMajuscule = UCase$(Left(Chaine, 1))
For nCar = 2 To Len(Chaine)
If (Mid$(Chaine, nCar - 1, 1) = " ") Or (Mid$(Chaine, nCar - 1, 1) = "-") Then
MiseEnMajuscule = MiseEnMajuscule & UCase$(Mid(Chaine, nCar, 1))
Else
MiseEnMajuscule = MiseEnMajuscule & LCase$(Mid(Chaine, nCar, 1))
End If
Next
End Function |
Utilisation : Msgbox MiseEnMajuscule("jean-paul") |
Ceci affichera : Jean-Paul
|
| |
Version : Access 2000 et supérieures
Cet exemple de code vous propose une fonction de conversion permettant de traduire
une date en différentes langues.
Par exemple :
Langue |
Date |
Français |
Paris, le 10 Mai 2005 |
Anglais |
Paris, May 10th 2005 |
Allemand |
Paris, den 10. Mai 2005 |
Espagnol |
Paris, 10 de mayo |
Dans un module, placez le code suivant :
Option Compare Database
Option Explicit
Public Enum Langue
langueFrancais
langueAnglais
langueAllemand
langueespagnol
End Enum
Public Function TradDate(strLocalite As String, dteDate As Date, lanLangue As Langue) As String
Dim strListeMoisLang(4) As String
Dim strTemp As String
Dim strMois() As String
strListeMoisLang(Langue.langueFrancais) = _
"Janvier;Février;Mars;Avril;Mai;Juin;Juillet;Août;Septembre;Octobre;Novembre;Décembre"
strListeMoisLang(Langue.langueAnglais) = _
"January;February;Mars;April;May;June;July;August; September;October;November;December"
strListeMoisLang(Langue.langueAllemand) = _
"Januar;Februar; an März;April;Mai;Juni;Juli;August;September;Oktober;November;Dezember"
strListeMoisLang(Langue.langueespagnol) = _
"El enero;febrero;marzo;abril;mayo;junio;julio;agosto;septiembre;octubre;noviembre;diciembre"
strMois = Split(strListeMoisLang(lanLangue), ";")
Select Case lanLangue
Case Langue.langueFrancais
strTemp = "le " & Day(dteDate) & " " & strMois(Month(dteDate) - 1) & " " & Year(dteDate)
Case Langue.langueAnglais
strTemp = strMois(Month(dteDate) - 1) & " " & Day(dteDate)
Select Case Day(dteDate)
Case 1: strTemp = strTemp & "st"
Case 2: strTemp = strTemp & "nd"
Case 3: strTemp = strTemp & "rd"
Case Else: strTemp = strTemp & "th"
End Select
strTemp = strTemp & ", " & Year(dteDate)
Case Langue.langueAllemand
strTemp = "den " & Day(dteDate) & ". " & strMois(Month(dteDate) - 1) & " " & Year(dteDate)
Case Langue.langueEspagnol
strTemp = Day(dteDate) & " de " & strMois(Month(dteDate) - 1) & " " & Year(dteDate)
End Select
TradDate = strLocalite & ", " & strTemp
End Function |
Exemple d'utilisation :
MsgBox TradDate("Metz", Now, langueAllemand) |
N'hésitez pas à ajouter de nouvelles langues et à me les faire parvenir pour une future intégration dans cette page.
|
| | Versions : 97 et supérieures Option Compare Database
Dim mot$(25), Résultat$, N$
Dim Virgule, B, K$, nombre$, longueur
Dim cdu$, C$, D$, U$, Et, Tiret
Sub Ajoute(MotSimple$)
If Résultat$ <> "" Then
If Right$(Résultat$, 1) = "-" Or _
MotSimple$ = "s" Or MotSimple$ = "-" Then
Résultat$ = Résultat$ + MotSimple$
Else
Résultat$ = Résultat$ + " " + MotSimple$
End If
Else
Résultat$ = MotSimple$
End If
End Sub
Function Equivalent$(Valeur)
Select Case Valeur
Case Is < 21
Equivalent$ = mot$(Valeur)
Case Else
Equivalent$ = mot$(18 + (Valeur / 10))
End Select
End Function
Function Nb2Mot$(Valeur$)
Dim a$
mot$(1) = "un"
mot$(2) = "deux"
mot$(3) = "trois"
mot$(4) = "quatre"
mot$(5) = "cinq"
mot$(6) = "six"
mot$(7) = "sept"
mot$(8) = "huit"
mot$(9) = "neuf"
mot$(10) = "dix"
mot$(11) = "onze"
mot$(12) = "douze"
mot$(13) = "treize"
mot$(14) = "quatorze"
mot$(15) = "quinze"
mot$(16) = "seize"
mot$(20) = "vingt"
mot$(21) = "trente"
mot$(22) = "quarante"
mot$(23) = "cinquante"
mot$(24) = "soixante"
a$ = Valeur$ + " "
N$ = ""
Virgule = 0
Résultat$ = ""
For B = 1 To Len(a$)
K$ = Mid$(a$, B, 1)
Select Case K$
Case "-"
Ajoute "moins"
Case "0" To "9"
N$ = N$ + K$
Case Else
If Virgule = 1 Then
N$ = Right$("000" + Left$(N$ + "000", 2), 2)
If Val(N$) = 0 Then N$ = ""
End If
TraduireEntier N$
If Virgule = 0 And Val(N$) > 0 Then
Ajoute "euro"
If Val(N$) > 1 Then Ajoute "s"
ElseIf Virgule = 1 And Val(N$) > 0 Then
Ajoute "centime"
If Val(N$) > 1 Then Ajoute "s"
End If
N$ = ""
Select Case K$
Case Chr$(13)
B = B + 1
Case Is < " "
Case ",", "."
Virgule = 1
If Val(a$) <> 0 And _
Val("0." + Mid$(a$, B + 1)) >= 0.01 Then Ajoute "et"
Case Else
End Select
End Select
Next
Nb2Mot$ = Résultat$
End Function
Sub TraduireEntier(NombreATraduire$)
nombre$ = NombreATraduire$
If nombre$ <> "" Then
If Val(nombre$) = 0 Then
Ajoute "zéro"
Else
nombre$ = Right$("000", -((Len(nombre$) Mod 3) <> 0) * (3 - (Len(nombre$) Mod 3))) _
+ nombre$
For longueur = Len(nombre$) To 3 Step -3
cdu$ = Left$(nombre$, 3)
nombre$ = Right$(nombre$, longueur - 3)
If cdu$ <> "000" Then
C$ = Left$(cdu$, 1)
D$ = Mid$(cdu$, 2, 1)
U$ = Right$(cdu$, 1)
If C$ >= "2" Then Ajoute Equivalent$(Val(C$))
If C$ >= "1" Then
Ajoute "cent"
If Val(nombre$) = 0 And D$ + U$ = "00" _
And Len(Résultat$) > 4 Then Ajoute "s"
End If
Et = (D$ >= "2") And (U$ = "1")
Tiret = ((D$ >= "2") And (U$ > "1") _
Or (D$ >= "1" And U$ >= "7")) And Not Et
If D$ >= "8" Then
Ajoute "quatre-vingt"
Et = 0
If D$ = "8" Then D$ = "0" _
Else D$ = "1": Tiret = True
If U$ > "0" Then Tiret = True Else Ajoute "s"
ElseIf D$ = "7" Then
Ajoute "soixante"
D$ = "1"
If U$ <> "1" Then Tiret = True
End If
If (D$ = "1") And (U$ <= "6") Then
D$ = "0"
U$ = "1" + U$
End If
If D$ >= "1" Then
If Tiret And D$ = "1" _
And Val(Right$(cdu$, 2)) > 19 Then
Ajoute "-"
End If
Ajoute Equivalent$(Val(D$ + "0"))
If D$ + U$ = "20" And C$ <> "0" Then Ajoute "s"
End If
If Et Then Ajoute "et"
If Tiret Then Ajoute "-"
If Val(U$) >= 22 Or ((Val(U$) >= 1 And (Val(cdu$) > 1 Or longueur <> 6))) Then
Ajoute Equivalent$(Val(U$))
End If
Select Case longueur
Case 6: Ajoute "mille"
Case 9: Ajoute "million"
If Val(cdu$) > 1 Then Ajoute "s"
Case 12
Ajoute "milliard"
If Val(cdu$) > 1 Then Ajoute "s"
Case Else
End Select
End If
Next
End If
End If
End Sub |
|
|