VBA getal omzetten in tekst

Status
Niet open voor verdere reacties.

oeldere

Terugkerende gebruiker
Lid geworden
26 dec 2008
Berichten
2.741
Op het Excel forum heb ik deze code gevonden voor het omzetten van een bedrag in tekst. Deze code (of functionaliteit) wil ik nu ook een een Word document gebruiken.

Ik heb de code in module1 geplaatst (in Word).

Ik heb hem proberen aan te roepen met =Eurogetal(7000).

Ik doe waarschijnlijk iets fout (of misschien kan het wel niet op deze manier).

Ik ben niet zo thuis in Word.

Wie kan en wil me hier bij helpen.

Alvast bedankt voor de moeite.


Code:
'auteur: KeepItCool

Option Expliciteuro
Option Compare Text

Dim eh$(99)
Dim vv$(12)

Function getaltekst(getal As Variant) As String
  Dim heel, deel    'decimal variants
  Dim txt$, n%      'string/int
  vulArrays
  heel = Int(CDec(Abs(getal)))
  deel = CDec(Abs(getal)) - heel

  txt = IIf(Sgn(getal) < 0, "min ", "") & _
    IIf(heel = 0, IIf(deel = 0, "nul", ""), spel(heel))

  If deel <> 0 Then
    txt = txt & IIf(heel = 0, "", " en ")
    n = Len(Mid(deel, 3))
    'boven miljoenste per macht van 3
    n = n + IIf(n < 6, 0, (3 - n Mod 3) Mod 3)
    deel = deel * (10 ^ n)
    txt = txt & spel(deel) & " " & _
      Trim(Replace(spel(10 ^ n), "een", "")) & _
      IIf(n = 1, "de", "ste")
  End If

  getaltekst = txt
End Function



Function spel$(n)
  Dim t$, tmp$, b$, b1$, b2$
  Dim i%, s%, hv%, dv%

  t = CStr(n)
  'blokje van 4 bij getal tm 9999
  s = IIf(Len(t) = 4, 4, 3)
  'met nullen vullen tot lengte een veelvoud is van 3
  t = String((s - Len(t) Mod s) Mod s, "0") & t

  For i = 1 To Len(t) Step s
    tmp = Mid(t, i, s)
    b1 = Left(tmp, Len(tmp) - 2)
    hv = IIf(Right(b1, 1) = 0, 3, 2)    'duizend/honderd
    b1 = IIf(Right(b1, 1) = 0, Left(b1, 1), b1) 'idem

    b1 = xx(b1)
    b1 = IIf(b1 = "een", " ", b1)       'geen eenhonderd
    b1 = b1 & IIf(b1 = "", "", vv(hv))  'plak veelvoud

    b2 = Right(tmp, 2)
    dv = Len(t) - i - (s - 1)           'duizendvoud
    b2 = xx(b2)

    'spatiëring
    'optioneel EN voor getal tm 12
    b2 = IIf(dv = 0 And b1 <> "" And _
      Right(tmp, 2) > 0 And Right(tmp, 2) <= 12, _
      "en " & b2, b2)
    b = Trim(b1 & " " & b2) & " "
    'geen spatie veelvoud duizend hfdtelwoord tm honderd
    If (dv = 3 And Right(tmp, 2) = "00") Then b = Trim(b)
    'geen spatie veelvoud honderd
    If (dv = 3 And tmp < 100) Then b = Trim(b)

    spel = Trim(spel & " " & b & IIf(tmp = "000", "", vv(dv)))
  Next
End Function

Private Function xx$(n$)
'spelt tm 99
  If eh(n) <> "" Then
    xx = eh(n)
  Else
    xx = eh(Right(n, 1)) & _
      IIf(Left(n, 1) = 1 Or Right(n, 1) = 0, "", _
        IIf(Right(xx, 1) = "e", "ën", "en")) & _
      IIf(eh(Left(n, 1) * 10) <> "", eh(Left(n, 1) * 10), _
        eh(Left(n, 1)) & vv(1))
  End If
  xx = Trim(xx)
End Function

Private Sub vulArrays()
  eh(0) = " "
  eh(1) = "een"
  eh(2) = "twee"
  eh(3) = "drie"
  eh(4) = "vier"
  eh(5) = "vijf"
  eh(6) = "zes"
  eh(7) = "zeven"
  eh(8) = "acht"
  eh(9) = "negen"
  eh(10) = "tien"
  eh(11) = "elf"
  eh(12) = "twaalf"
  eh(13) = "dertien"
  eh(14) = "veertien"
  eh(20) = "twintig"
  eh(30) = "dertig"
  eh(40) = "veertig"
  eh(80) = "tachtig"
  vv(1) = "tig"
  vv(2) = "honderd"
  vv(3) = "duizend"
  vv(6) = "miljoen"
  vv(9) = "miljard"
  vv(12) = "biljoen"
End Sub

Function GetalEuro(getal As Variant) As String
  Dim heel, deel    'decimal variants
  Dim txt$, n%      'string/int
  vulArrays
  heel = Int(CDec(Abs(getal)))
  deel = Round(CDec(Abs(getal)) - heel, 2)
  txt = IIf(Sgn(getal) < 0, "min ", "") & _
    IIf(heel = 0, IIf(deel = 0, "nul", ""), spel(heel))
  If heel > 0 Then txt = txt & IIf(deel = 0, " euro", " euro en ")
  If deel <> 0 Then
    deel = Int(Abs(deel * 100))
    txt = txt & spel(deel) & " cent"
  End If
  GetalEuro = txt
End Function
 

Bijlagen

Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan