Nombres: code
In de module:
- Een enkelvoudig getal, met inbegrip van de speciale gevallan
Private Function nombresimple(ByVal n As Integer) As String
Select Case n
Case 1
nombresimple = "un"
Case 2
nombresimple = "deux"
Case 3
nombresimple = "trois"
Case 4
nombresimple = "quatre"
Case 5
nombresimple = "cinq"
Case 6
nombresimple = "six"
Case 7
nombresimple = "sept"
Case 8
nombresimple = "huit"
Case 9
nombresimple = "neuf"
Case 10
nombresimple = "dix"
Case 11
nombresimple = "onze"
Case 12
nombresimple = "douze"
Case 13
nombresimple = "treize"
Case 14
nombresimple = "quatorze"
Case 15
nombresimple = "quinze"
Case 16
nombresimple = "seize"
Case 17
nombresimple = "dix-sept"
Case 18
nombresimple = "dix-huit"
Case 19
nombresimple = "dix-neuf"
Case 20
nombresimple = "vingt"
Case 30
nombresimple = "trente"
Case 40
nombresimple = "quarante"
Case 50
nombresimple = "cinquante"
Case 60
nombresimple = "soixante"
Case 70
nombresimple = "soixante-dix"
Case 71
nombresimple = "soixante et onze"
Case 72
nombresimple = "soixante-douze"
Case 73
nombresimple = "soixante-treize"
Case 74
nombresimple = "soixante-quatorze"
Case 75
nombresimple = "soixante-quinze"
Case 76
nombresimple = "soixante-seize"
Case 77
nombresimple = "soixante-dix-sept"
Case 78
nombresimple = "soixante-dix-huit"
Case 79
nombresimple = "soixante-dix-neuf"
Case 80
nombresimple = "quatre-vingt"
Case 81
nombresimple = "quatre-vingt-un"
Case 90
nombresimple = "quatre-vingt-dix"
Case 91
nombresimple = "quatre-vingt-onze"
Case 92
nombresimple = "quatre-vingt-douze"
Case 93
nombresimple = "quatre-vingt-treize"
Case 94
nombresimple = "quatre-vingt-quatorze"
Case 95
nombresimple = "quatre-vingt-quinze"
Case 96
nombresimple = "quatre-vingt-seize"
Case 97
nombresimple = "quatre-vingt-dix-sept"
Case 98
nombresimple = "quatre-vingt-dix-huit"
Case 99
nombresimple = "quatre-vingt-dix-neuf"
End Select
End Function
- Een groep van drie
Private Function nombretriple(nombre As Integer) As String
'met en lettres un chiffre de trois nombres
Dim temp As String
Dim centaines As Integer
Dim dizaines As Integer
Dim unites As Integer
Dim cnombre As Integer
cnombre = nombre
centaines = cnombre \ 100
cnombre = cnombre - centaines * 100
dizaines = cnombre \ 10
cnombre = cnombre - dizaines * 10
unites = cnombre
If Not centaines = 0 Then
'le premier chiffre
If centaines = 1 Then
temp = "cent"
Else
If Not centaines = 0 Then temp = nombresimple(centaines) & " cent"
End If
If dizaines + unites = 0 Then
If centaines > 1 Then temp = temp & "s" 'termine le chiffre
nombretriple = temp
Exit Function
Else
If Not temp = "" Then temp = temp & " "
End If
End If
If nombresimple(dizaines * 10 + unites) = "" Then
If unites = 1 Then
temp = temp & nombresimple(dizaines * 10) & " et un"
Else
temp = temp & nombresimple(dizaines * 10) & "-" &
nombresimple(unites)
End If
Else
temp = temp & nombresimple(dizaines * 10 + unites)
End If
If Right(temp, 12) = "quatre-vingt" Then temp = temp & "s"
nombretriple = temp
End Function
- En voor een volledig getal:
Public Function enlettres(nombre As Long) As String
Dim cnombre As Double
Dim millions As Integer
Dim milliers As Integer
Dim unites As Integer
Dim temp As String
cnombre = nombre
millions = cnombre \ 1000000
cnombre = cnombre - millions * 1000000
milliers = cnombre \ 1000
'cnombre = cnombre - (milliers * 1000)
unites = cnombre Mod 1000
If Not millions = 0 Then temp = nombretriple(millions) & " million"
If millions > 1 Then temp = temp & "s"
If Not milliers = 0 Then
If milliers > 1 Then
If Not temp = "" Then temp = temp & " "
temp = temp & nombretriple(milliers)
End If
temp = temp & " mille "
End If
If Not unites = 0 Then temp = temp & nombretriple(unites)
If temp = "" Then temp = "zéro"
enlettres = temp
End Function
Sub test(Optional ByRef start As Long)
Do
MsgBox start & ": " & enlettres(start)
start = start + 1
Loop
End Sub
Sub cherchelong(Optional ByRef start As Long)
Dim pluslong As Integer
Do
If Len(enlettres(start)) > pluslong Then
pluslong = Len(enlettres(start))
End If
start = start + 1
Loop
End Sub
In het formulier:
- Van cijfers naar tekst:
If Text1.Text = "" Then Exit Sub
If Not IsNumeric(Text1.Text) Then Exit Sub
Label1.Caption = enlettres(Text1.Text)
- Van tekst naar cijfers:
On Error Resume Next
Label1.Caption = ""
MousePointer = vbHourglass
Dim t As Long
For t = 0 To 200000000
If enlettres(t) = Text2.Text Then
Label1.Caption = t
MousePointer = vbNormal
Exit Sub
End If
Next t
MousePointer = vbNormal
End Sub
[VB Web] - [hlrnet] - [copyright]