chahnou
État :
Absent
|
Bonjour la compagnie,
Voila je me trouve devant un probleme qui paraitrait facile mais comme je ne me suis jamais pencher sur la question , il est devenu pour moi tres difficile.
je voudrais savoir comment pourrais je inserer un code source dans ma base de donnes , la procedure s'il vous plait
Dans le cas present je veut insere le code souce qui convertis les nombres en lettres dans ma facture .
voici le code source
windows xp , office 2000
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$)
'--- ajoute un nouveau terme traduit à la chaine résultat
If Résultat$ <> "" Then
'--- vérifie s'il est nécessaire de coller le nouveau terme au
'--- précédent dans le cas des "S" à rajouter, ou des tirets
If Right$(Résultat$, 1) = "-" Or _
MotSimple$ = "s" Or MotSimple$ = "-" Then
Résultat$ = Résultat$ + MotSimple$
'--- sinon, ajoute le terme après un espace
Else
Résultat$ = Résultat$ + " " + MotSimple$
End If
Else
Résultat$ = MotSimple$
End If
End Sub
Function Equivalent$(Valeur)
'--- recherche le mot équivalent à une valeur numérique
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$
'--- initialisation du tableau contenant les mots interprétés
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"
'--- récupération de paramètre passé
a$ = Valeur$ + " "
'--- initialisation des variables de travail
N$ = ""
Virgule = 0
Résultat$ = ""
'--- pour toute la longueur de celui-ci
For B = 1 To Len(a$)
'--- on extrait chacun de ses caractères
K$ = Mid$(a$, B, 1)
Select Case K$
'--- gère les montants négatifs
Case "-"
Ajoute "moins"
'--- si ceux-ci sont numériques, on batit la chaine n$
Case "0" To "9"
N$ = N$ + K$
'--- sinon, on teste si on est arrivé à une virgule
Case Else
If Virgule = 1 Then
'--- les centimes sont comptés sur 2 digits, réajustés de
'--- manière inverse aux euros, puisqu'on lit les unités
'--- et dizaines de manière inversée (0,2? = 20c et
'--- 0,02?=2c)
N$ = Right$("000" + Left$(N$ + "000", 2), 2)
If Val(N$) = 0 Then N$ = ""
End If
'--- on traduit le nombre stocké dans n$
TraduireEntier N$
'--- puis on détermine son unité en fonction de la présence
'--- ou non d'une virgule
If Virgule = 0 And Val(N$) > 0 Then
Ajoute "euro"
'--- et on accorde l'unité avec le nombre
If Val(N$) > 1 Then Ajoute "s"
ElseIf Virgule = 1 And Val(N$) > 0 Then
Ajoute "centime"
'--- en ajoutant un "s" si nécessaire
If Val(N$) > 1 Then Ajoute "s"
End If
N$ = ""
Select Case K$
Case Chr$(13)
B = B + 1
Case Is < " "
Case ",", "."
Virgule = 1
'--- si une valeur en euros est exprimée, et que le
'--- nombre de centimes est suffisant pour être traité,
'--- on lie les 2 par le mot "et"
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$)
'--- convertit un nombre entier contenu dans une chaine de caractères
'--- en son équivalent ordinal
nombre$ = NombreATraduire$
If nombre$ <> "" Then
'--- si le nombre est 0, on ne perd pas de temps
If Val(nombre$) = 0 Then
Ajoute "zéro"
Else
'--- sinon, on convertit celui-ci en une chaine de caractères
'--- de longueur multiple de 3, afin de pouvoir la lire par blocs
'--- de 3 caractères
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)
'--- on extrait ainsi des ensembles de 3 chiffres, de la
'--- gauche vers la droite
If cdu$ <> "000" Then
'--- dont on tire une valeur de centaines, dizaines et
'--- unités
C$ = Left$(cdu$, 1)
D$ = Mid$(cdu$, 2, 1)
U$ = Right$(cdu$, 1)
'--- on convertit les unités non muettes pour les
'--- centaines
If C$ >= "2" Then Ajoute Equivalent$(Val(C$))
'--- et on traite les 1 muets
If C$ >= "1" Then
Ajoute "cent"
'--- en appliquant les règles d'accords pour les
'--- centaines
If Val(nombre$) = 0 And D$ + U$ = "00" _
And Len(Résultat$) > 4 Then Ajoute "s"
End If
'--- on analyse si le mot ET est nécessaire (21, 31,
'--- 41 ...)
Et = (D$ >= "2") And (U$ = "1")
'--- ainsi que les tirets pour certains couples
'--- dizaines-unités
Tiret = ((D$ >= "2") And (U$ > "1") _
Or (D$ >= "1" And U$ >= "7")) And Not Et
'--- traitement des valeurs 80-99
If D$ >= "8" Then
Ajoute "quatre-vingt"
Et = 0
'--- retenue nécessaire pour 90 à 99
If D$ = "8" Then D$ = "0" _
Else D$ = "1": Tiret = True
'--- et traitement des unités
If U$ > "0" Then Tiret = True Else Ajoute "s"
'--- sinon on traite les valeurs 70 à 79
ElseIf D$ = "7" Then
Ajoute "soixante"
'--- avec une retenue pour les dizaines
D$ = "1"
If U$ <> "1" Then Tiret = True
End If
'--- valeurs entre 10 et 16
If (D$ = "1") And (U$ <= "6") Then
D$ = "0"
U$ = "1" + U$
End If
'--- sinon, on gère toutes les autres dizaines
If D$ >= "1" Then
'--- gère les tirets pour les dizaines composées
If Tiret And D$ = "1" _
And Val(Right$(cdu$, 2)) > 19 Then
Ajoute "-"
End If
'--- traduction de la dizaine...
Ajoute Equivalent$(Val(D$ + "0"))
'--- en accordant l'exception des vingtaines
If D$ + U$ = "20" And C$ <> "0" Then Ajoute "s"
End If
'--- si le mot Et est nécessaire, on l'ajoute
If Et Then Ajoute "et"
'--- ainsi que le tiret, liant une dizaine et une
'--- unité
If Tiret Then Ajoute "-"
'--- puis on traduit l'unité du nombre
If Val(U$) >= 22 Or ((Val(U$) >= 1 And (Val(cdu$) > 1 Or longueur <> 6))) Then
Ajoute Equivalent$(Val(U$))
End If
'--- enfin, la pondération du nombre est respectée,
'--- en ajoutant le multiple nécessaire, et en
'--- l'accordant s'il le faut
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
Merci par avance
|