Getal in letters

Status
Niet open voor verdere reacties.
Boxman

Boxman

Gebruiker
Lid geworden
4 nov 2008
Berichten
87
Leden van het forum,

in een tabel heb ik een kolom die wordt gevuld vanuit een formulier met een getal (nummeriek dus) nu wil ik in de kolom ernaast het getal in letters hebben

ongetwijfeld staat er ergens op het forum het antwoord maar kan deze niet traceren :o

alvast bedankt
 
Op deze pagina van Microsof staat een uitgebreide functie die een getal kan vertalen naar (Engelstalige) tekst. Met wat kleine aanpassingen ook werkend te maken voor Nederland, lijkt mij. Mooie uitdaging?
 
Omdat deze functie van OfficeForum naar mijn idee toch niet helemaal jofel is vertaald, hier mijn versie:
Code: 
Function GetalNaarTekst(ByVal MyNumber)
'********************************
'********* Main Function ********
'********************************
Dim Dollars As String, Cents As String, Temp
Dim DecimalPlace As Integer, Count As Integer, i As Integer
Dim tmp() As String
ReDim Place(9) As String
Place(2) = " duizend "
Place(3) = " miljoen "
Place(4) = " miljard "
Place(5) = "onzin getal "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
    Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
    MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
    Temp = GetHundreds(Right(MyNumber, 3))
    If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
    If Len(MyNumber) > 3 Then
        MyNumber = Left(MyNumber, Len(MyNumber) - 3)
    Else
        MyNumber = ""
    End If
    Count = Count + 1
Loop
Select Case Dollars
    Case ""
        Dollars = ""
    Case "One"
        Dollars = "één Euro"
    Case Else
        Dollars = Dollars & " Euro"
End Select
Select Case Cents
    Case ""
        If Dollars <> "" Then Cents = " en "
        Cents = Cents & "nul cent"
    Case "One"
        If Dollars <> "" Then Cents = " en "
        Cents = Cents & "één cent"
    Case Else
        If Dollars <> "" Then
            Cents = " en " & Cents & " cent"
        Else
            Cents = Cents & " cent"
        End If
End Select
GetalNaarTekst = Trim(Dollars & Cents)
If InStr(1, GetalNaarTekst, " ") > 0 Then
    tmp = Split(GetalNaarTekst, " ")
    tmp(LBound(tmp)) = StrConv(tmp(LBound(tmp)), vbProperCase)
    GetalNaarTekst = ""
    For i = LBound(tmp) To UBound(tmp)
        If i > LBound(tmp) Then tmp(i) = LCase(tmp(i))
        GetalNaarTekst = GetalNaarTekst & " " & tmp(i)
    Next i
End If
GetalNaarTekst = Trim(GetalNaarTekst)
End Function
Function GetHundreds(ByVal MyNumber)
'*******************************************
' Converts a number from 100-999 into text *
'*******************************************
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
    If Mid(MyNumber, 1, 1) = "1" Then
''        Result = GetDigit(Mid(MyNumber, 1, 1)) & "Honderd "
        Result = "Honderd "
    Else
        Result = StrConv(GetDigit(Mid(MyNumber, 1, 1)), vbProperCase) & "honderd "
    End If
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
    Result = Trim(Result) & Trim(LCase(GetTens(Mid(MyNumber, 2))))
Else
    Result = Trim(Result) & Trim(LCase(GetDigit(Mid(MyNumber, 3))))
End If
GetHundreds = Result
End Function
Function GetTens(TensText)
'*********************************************
' Converts a number from 10 to 99 into text. *
'*********************************************
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 0 Then ' If value between 0-9...
    Result = GetDigit(Right(TensText, 1))
ElseIf Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
    Select Case Val(TensText)
        Case 10: Result = "Tien"
        Case 11: Result = "Elf"
        Case 12: Result = "Twaalf"
        Case 13: Result = "Dertien"
        Case 14: Result = "Veertien"
        Case 15: Result = "Vijftien"
        Case 16: Result = "Zestien"
        Case 17: Result = "Zeventien"
        Case 18: Result = "Achtien"
        Case 19: Result = "Negentien"
        Case Else
    End Select
Else ' If value between 20-99...
    Select Case Val(Left(TensText, 1))
        Case 2: Result = "twintig "
        Case 3: Result = "dertig "
        Case 4: Result = "veertig "
        Case 5: Result = "vijftig "
        Case 6: Result = "zestig "
        Case 7: Result = "zeventig "
        Case 8: Result = "tachtig "
        Case 9: Result = "negentig "
        Case Else
    End Select
    If Right(TensText, 1) <> 0 Then
        Result = GetDigit(Right(TensText, 1)) & "en" & Result
    End If
End If
GetTens = Result
End Function
Function GetDigit(Digit)
'*******************************************
' Converts a number from 1 to 9 into text. *
'*******************************************
Select Case Val(Digit)
    Case 1: GetDigit = "Een"
    Case 2: GetDigit = "Twee"
    Case 3: GetDigit = "Drie"
    Case 4: GetDigit = "Vier"
    Case 5: GetDigit = "Vijf"
    Case 6: GetDigit = "Zes"
    Case 7: GetDigit = "Zeven"
    Case 8: GetDigit = "Acht"
    Case 9: GetDigit = "Negen"
    Case Else: GetDigit = ""
    End Select
End Function
 
Tja, die uitdaging was al weg door de link van Tardis.... En omdat ik 'm niet netjes genoeg vond, heb ik die van mij er ook maar bij gezet. Tenslotte kan iedereen tegenwoordig wel een linkje aanklikken en kopieëren ;)
 
OctaFish zei:
Tenslotte kan iedereen tegenwoordig wel een linkje aanklikken en kopieëren ;)
Klik om te vergroten...

Gelukkig wel, zouden meer mensen moeten doen.
Joh waar jij allemaal tijd voor hebt, heb je geen job en/of andere hobbies/verplichtingen?
Je kan zo langzamerhand wel beginnen als ZZP'er, dan doet het bedrijfsleven tenminste wat er vaker zou moeten gebeuren in mijn perceptie, namelijk gewoon kennis inhuren en betalen :P
(OK, met uitzondering van kleinere non-profit organisaties dan.....)
Verdien je er zelf ook wat aan.

Tardis
 
heb je geen job en/of andere hobbies/verplichtingen?
Klik om te vergroten...

@Tardis,

Voor als je het echt wilt weten, ik heb ergens in 1 van zijn antwoorden gelezen dat hij applicatiebeheerder bij de gemeente Amsterdam is. Hij heeft dus een baan.
 
Bakk4318 zei:
@Tardis,

Voor als je het echt wilt weten, ik heb ergens in 1 van zijn antwoorden gelezen dat hij applicatiebeheerder bij de gemeente Amsterdam is. Hij heeft dus een baan.
Klik om te vergroten...

Joh was maar een grapje.
Vind het knap als iemand zo gedreven kan zijn.

Tardis
 
Tis meer een vorm van verslaving; vrees ik.
Ik kom al opdraven voor een moorkop, dus rijk word ik er ook niet van :)
Is uiteraard ook niet de opzet...
 
Bedankt

Heren ik wil jullie hartelijk bednaken voor de genomen moeite
 
valuta eruit

ik heb een poging gedaan de valuta uit de functie te halen maar op de een of andere manier krijg ik telkens foutmeldingen :evil:

wat gaat er mis ????
 
Wat bedoel je daarmee? Er is een vermelding naar Euro's; moet die er uit?
 
Zoiets?

Code: 
Public Function GetalNaarTekst(ByVal MyNumber)
'****************
' Main Function *
'****************
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = "duizend "
Place(3) = " miljoen "
Place(4) = " miljard "
Place(5) = " onzin getal "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
    Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
    MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
    Temp = GetHundreds(Right(MyNumber, 3))
    If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
    If LCase(Left(Dollars, 10)) = "eenduizend" Then Dollars = Mid(Dollars, 4, Len(Dollars) - 3)
    If Len(MyNumber) > 3 Then
        MyNumber = Left(MyNumber, Len(MyNumber) - 3)
    Else
        MyNumber = ""
    End If
    Count = Count + 1
Loop
Select Case Dollars
    Case ""
        Dollars = "Geen waarde"
    Case "One"
        Dollars = "één"
    Case Else
        Dollars = Dollars
End Select
Select Case Cents
Case ""
    Cents = ""
Case "One"
    Cents = " en één honderste"
Case Else
    Cents = " en " & Cents & " honderste"
End Select
GetalNaarTekst = Dollars & Cents
End Function
Function GetHundreds(ByVal MyNumber)
'*******************************************
' Converts a number from 100-999 into text *
'*******************************************
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
    Result = GetDigit(Mid(MyNumber, 1, 1)) & "honderd "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
    Result = Result & GetTens(Mid(MyNumber, 2))
Else
    Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function
Function GetTens(TensText)
'*********************************************
' Converts a number from 10 to 99 into text. *
'*********************************************
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
    Select Case Val(TensText)
        Case 10: Result = "tien"
        Case 11: Result = "elf"
        Case 12: Result = "twaalf"
        Case 13: Result = "dertien"
        Case 14: Result = "veertien"
        Case 15: Result = "vijftien"
        Case 16: Result = "zestien"
        Case 17: Result = "zeventien"
        Case 18: Result = "achtien"
        Case 19: Result = "negentien"
        Case Else
    End Select
    Else ' If value between 20-99...
    Select Case Val(Left(TensText, 1))
        Case 2: Result = "twintig "
        Case 3: Result = "dertig "
        Case 4: Result = "veertig "
        Case 5: Result = "vijftig "
        Case 6: Result = "zestig "
        Case 7: Result = "zeventig "
        Case 8: Result = "tachtig "
        Case 9: Result = "negentig "
        Case Else
    End Select
    If Right(TensText, 1) <> 0 Then
        Result = GetDigit(Right(TensText, 1)) & "en" & Result
    End If
End If
GetTens = Result
End Function
Function GetDigit(Digit)
'*******************************************
' Converts a number from 1 to 9 into text. *
'*******************************************
    Select Case Val(Digit)
    Case 1: GetDigit = "een"
    Case 2: GetDigit = "twee"
    Case 3: GetDigit = "drie"
    Case 4: GetDigit = "vier"
    Case 5: GetDigit = "vijf"
    Case 6: GetDigit = "zes"
    Case 7: GetDigit = "zeven"
    Case 8: GetDigit = "acht"
    Case 9: GetDigit = "negen"
    Case Else: GetDigit = ""
    End Select
End Function
 
Dan heb je de nieuwe code waarschijnlijk naast de vorige in een nieuwe module gezet. Je moet die ofwel verwijderen, ofwel hernoemen.
 
werkt iderdaad wel goed

Weet niet wat er mis ging

heb het opnieuw gedaan en nu doet hij het wel

Bedankt
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan