Prenons en de la graine

[winfield]

Ramassé je ne sais plus quel site :

Ces functions permettent de transformer un nombre (écrit en chiffre) en lettres

 

Function NumText(Nombre As Currency, Optional Unité As String,  _
           Optional SousUnité As String, Optional no_chiffres As Integer,  _
           Optional Separateur 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é & Separateur & 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 

 

 

[didier]

coucou

 

je n'ai pas pas testé celle-ci

mais j'ai quelque chose du même genre sur Excel.

 

l'utilité dans AutoCad reste à démontrer

mais ne serait-ce que pour le fun, ça vaut le coup.

 

dans tous les cas, merci d'échanger les connaissances.

 

amicalement

[yusukens82]

Bonjours

moi aussi j'utilise Excel pour ce genre de chose.

et pareil, juste pour le fun j'ai voulu le testé, mais en je vois qu'on s'en sert pas comme un LISP.

Pouvez vous me dire comment on fait pour intégrer cette fonction dans autocad ?

 

merci

[winfield]

Salut, dans autocad, tu fais Alt+F11 et tu te retrouves dans l'éditeur vb. A gauche, dans l'abrborescence, tu inseres un nouveau module et tu y copies/colles le code.

Pour tester tu peux aussi coller ces bouts de codes :

Sub test1()
   Dim CurValeur As Currency
   Dim Pt(2) As Double
   Dim ObjText As AcadText
   
   Pt(0) = 0: Pt(1) = 0
   CurValeur = InputBox("Saisissez un nombre", "Nombre")
   Set ObjText = ThisDrawing.ModelSpace.AddText((NumText(CurValeur)), Pt, 5)
   ZoomAll

End Sub
'------------------------------------------------------
Sub test2()

   Dim CurValeur As Currency
   Dim Pt(2) As Double
   Dim ObjText As AcadText
   
   Pt(0) = 0: Pt(1) = 0
   CurValeur = InputBox("Saisissez un nombre", "Nombre")
   Set ObjText = ThisDrawing.ModelSpace.AddText((NumText(CurValeur, "€uros", "centimes.", 2, " et ")), Pt, 5)
   ZoomAll

End Sub

 

Tu clics entre le Sub et le End Sub de la routine (test1 ou test2) et appuye sur F5.

 

Je te laisse voir ce que tu peux en faire sous un tableur, un traitement de texte ou autres...

 

J'envisage de traduire ces functions pour OpenOffice...Quand j'aurais le temps. S'il y en a qui sont interressé faites signe. Je m'activerai peut-être plus vite.

 

En tous cas, chapeau bas à l'auteur, qui est un Bel inconnu....je ne sais vraiment plus où j'ai dégoté ces functions.

[yusukens82]

Merci winfield.

c'est comme la VBA sous excel alors.

 

J'ai essayé de faire ce que tu as écrit mais cela ne marche pas, je te d'écrit les différentes étapes que j'ai fais :

 

- Ouverture d'un fichier DWG

- Alt+F11

- Insertion ==> module

- (Dans la fenetre du module) ==> copie coller :

Sub test1()

Dim CurValeur As Currency

Dim Pt(2) As Double

Dim ObjText As AcadText

 

Pt(0) = 0: Pt(1) = 0

CurValeur = InputBox("Saisissez un nombre", "Nombre")

Set ObjText = ThisDrawing.ModelSpace.AddText((NumText(CurValeur)), Pt, 5)

ZoomAll

 

End Sub

'------------------------------------------------------

Sub test2()

 

Dim CurValeur As Currency

Dim Pt(2) As Double

Dim ObjText As AcadText

 

Pt(0) = 0: Pt(1) = 0

CurValeur = InputBox("Saisissez un nombre", "Nombre")

Set ObjText = ThisDrawing.ModelSpace.AddText((NumText(CurValeur, "€uros", "centimes.", 2, " et ")), Pt, 5)

ZoomAll

 

End Sub

- Je clic sur le commentaire : --------------------- (Sub et le End Sub de la routine )

- J'appuis sur F5

- J'execute test1

- et voila l'erreur qu'il affiche :

- Erreur de compilation : Sub ou Function non définie ==> je clic sur OK

- et la ligne (( Sub test1() )) et souligné en jaune.

[didier]

coucou

 

ben alors !!! si tu la charges pas la fonction, :( !!!

comment veux-tu qu'elle soit reconnue ???

 

ton ordi est malin, mais il ne sait pas que tu copies-colles depuis CadXP ....

 

donc

dans un nouveau module, il faut TOUT copier...

ensuite dans le test1, il sera fait appel à la fonction NUMTEXT

qui sera alors reconnue.

 

amicalement

[winfield]

Désolé,

on croit être clair alors que ce n'est pas le cas....môa, je me comprends et je suis d'accord avec moi-même c'est l'essentiel non ? ;)

tu inseres un nouveau module et tu y copies/colles le code.

Je parlais du code des Functions.

Comme l'a dit Didier, il faut tout...

 

Et comme tu le souligne, c'est comme sous excel.

[yusukens82]

Oui j'avais oublié de copier la funtion.

merci ça marche super bien.

^^