Option Explicit

'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+ inWorten(): wandelt eine max. 306 stellige Zahl in einen String um
'+ Vorzeichenbehandlung, Nachkommaanteilanzeige,Stringtrennung
'+ Großschreibung und weitere Ausgabeformatierungen wurden hier
'+ entfernt - ES WIRD HIER NUR DER GANZZAHLIGE ANTEIL (vor dem Komma)
'+ IN EINEN STRING UMGEWANDELT!
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


Public Function inWorten(Eingabezahl As String) As String

'lokale Variablendeklaration
'    max 999 Quinquagintilliarden...usw
Const bereich = 306
Const d_ber = 101
'   Arrays für Zahlstringdefinitionen
Dim e(9) As String
Dim z(13) As String
Dim d(d_ber) As String
'   Array für die einzelnen Ziffern der Eingabezahl
Dim ziffer(bereich) As Integer
'
Dim my_string As String
Dim i As String
Dim ztemp As String
'
Dim Kommastelle As Integer
Dim j As Integer
Dim l As Integer
Dim k As Integer
Dim temp As Integer
Dim th As Integer
Dim tz As Integer
Dim te As Integer

On Error Resume Next

'Initialisierung

For j = 0 To bereich
 ziffer(j) = 0
Next j

'Number defs
e(0) = "null"
e(1) = "ein": e(2) = "zwei": e(3) = "drei"
e(4) = "vier": e(5) = "fünf": e(6) = "sechs"
e(7) = "sieben": e(8) = "acht": e(9) = "neun"
z(10) = "sech" 'Sonderfall für 16
z(13) = "sieb" 'Sonderfall 17

z(1) = "zehn": z(2) = "zwanzig": z(3) = "dreißig"
z(4) = "vierzig": z(5) = "fünfzig": z(6) = "sechzig"
z(7) = "siebzig": z(8) = "achtzig": z(9) = "neunzig"
z(11) = "elf": z(12) = "zwölf"

d(0) = "hundert": d(1) = "tausend": d(2) = "million": d(3) = "milliarde"
d(4) = "billion": d(5) = "billiarde": d(6) = "trillion": d(7) = "trilliarde"
d(8) = "quadrillion": d(9) = "quadrilliarde": d(10) = "quintillion": d(11) = "quintilliarde"
d(12) = "sextillion": d(13) = "sextilliarde": d(14) = "septillion": d(15) = "septilliarde"
d(16) = "oktillion": d(17) = "oktilliarde": d(18) = "nonillion": d(19) = "nonilliarde"
d(20) = "dezillion": d(21) = "dezilliarde": d(22) = "undezillion": d(23) = "undezilliarde"
d(24) = "duodezillion": d(25) = "doudezilliarde": d(26) = "tredezillion": d(27) = "tredezilliarde"
d(28) = "quattuordezillion": d(29) = "quattuordezilliarde": d(30) = "quindezillion": d(31) = "quindezilliarde"
d(32) = "sexdezillion": d(33) = "sexdezilliarde": d(34) = "septendezillion": d(35) = "septendezilliarde"
d(36) = "oktodezillion": d(37) = "oktodezilliarde": d(38) = "novemdezillion": d(39) = "novemdezilliarde"
d(40) = "vigintillion": d(41) = "vigintilliarde": d(42) = "unvigintillion": d(43) = "unvigintilliarde"
d(44) = "duovigintillion": d(45) = "duovigintilliarde": d(46) = "trevigintillion": d(47) = "trevigintilliarde"
d(48) = "quattuorvigintillion": d(49) = "quattuorvigintilliarde": d(50) = "quinvigintillion": d(51) = "quinvigintilliarde"
d(52) = "sexvigintillion": d(53) = "sexvigintilliarde": d(54) = "septenvigintillion": d(55) = "septenvigintilliarde"
d(56) = "oktovigintillion": d(57) = "oktovigintilliarde": d(58) = "novemvigintillion": d(59) = "novemvigintilliarde"
d(60) = "trigintillion": d(61) = "trigintilliarde": d(62) = "untrigintillion": d(63) = "untrigintilliarde"
d(64) = "duotrigintillion": d(65) = "duotrigintilliarde": d(66) = "tretrigintillion": d(67) = "tretrigintilliarde"
d(68) = "quattuortrigintillion": d(69) = "quattuortrigintilliarde": d(70) = "quintrigintillion": d(71) = "quintrigintilliarde"
d(72) = "sextrigintillion": d(73) = "sextrigintilliarde": d(74) = "septentrigintillion": d(75) = "septentrigintilliarde"
d(76) = "oktotrigintillion": d(77) = "oktotrigintilliarde": d(78) = "novemtrigintillion": d(79) = "novemtrigintilliarde"
d(80) = "quadragintillion": d(81) = "quadragintilliarde": d(82) = "unquadragintillion": d(83) = "unquadragintilliarde"
d(84) = "duoquadragintillion": d(85) = "duoquadragintilliarde": d(86) = "trequadragintillion": d(87) = "trequadragintilliarde"
d(88) = "quattuorquadragintillion": d(89) = "quattuorquadragintilliarde": d(90) = "quinquadragintillion": d(91) = "quinquadragintilliarde"
d(92) = "sexquadragintillion": d(93) = "sexquadragintilliarde": d(94) = "septenquadragintillion": d(95) = "septenquadragintilliarde"
d(96) = "oktoquadragintillion": d(97) = "oktoquadragintilliarde": d(98) = "novemquadragintillion": d(99) = "novemquadragintilliarde"
d(100) = "quinquagintillion": d(101) = "quinquagintilliarde"


'Quelle: http://www.rhrk.uni-kl.de/~jonietz/jufo/1999a/node16.html
''neue Quelle: http://www.uni-bonn.de/~manfear/numbers_names.php
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+ Berechnung starten (es wird nur der ganzzahlige Anteil angezeigt!)
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

my_string = ""
Kommastelle = InStr(1, Eingabezahl, ",")

i = CStr(Eingabezahl)
If Kommastelle > 0 Then i = Left(CStr(Eingabezahl), Kommastelle - 1)
j = 0

'Sonderfall 0
If i = "0" Or i = "" Then my_string = e(0)

'spalte die Zahl in ihre (max bereich) Ziffern
While i > ""
    j = j + 1
    ztemp = Right(i, 1)
   
    'Tausendertrennung etc. ignorieren
    'nur die Ziffern "0" bis "9" werden im Array abgelegt
    Select Case ztemp
       Case "0" To "9": ziffer(j) = CInt(ztemp)
       Case Else: j = j - 1
       End Select
    i = Left(i, Len(i) - 1)
    Wend
 
'Zahl ist für die Umwandlung in einen String zu gross!
If j > bereich Then
    inWorten = "Eingabezahl zu groß!"
    Exit Function
    End If
 
'Bestimmung der Anzahl der 3er Gruppen
k = (j - 1) \ 3  '0,1,2,...
 
'arbeite die Zahl in 3er Gruppen ab
For l = k To 0 Step -1
   th = ziffer(l * 3 + 3) 'Hunderterposition
   te = ziffer(l * 3 + 1) 'Einerposition
   tz = ziffer(l * 3 + 2) 'Zehnerposition
   'erzeuge Hunderteranteil der 3erGruppe
   If th > 0 Then my_string = my_string & e(th) & d(0)
   'erzeuge Eineranteil der 3er Gruppe
   Select Case te
   Case 0: Select Case tz
             Case 0: my_string = my_string
             Case Else: my_string = my_string & z(tz)
           End Select
   Case 3, 4, 5, 8, 9: Select Case tz
                 Case 0: my_string = my_string & e(te)
                 Case 1: my_string = my_string & e(te) & z(tz)
                 Case Else: my_string = my_string & e(te) & "und" & z(tz)
                End Select
   'prüfe auf "11"
   Case 1: Select Case tz
                Case 0: my_string = my_string & e(te)
                Case 1: my_string = my_string & z(11)
                Case Else: my_string = my_string & e(te) & "und" & z(tz)
           End Select
   'prüfe auf "12"
   Case 2: Select Case tz
                Case 0: my_string = my_string & e(te)
                Case 1: my_string = my_string & z(12)
                Case Else: my_string = my_string & e(te) & "und" & z(tz)
           End Select
   'prüfe auf "16" und "17" sechzehn und nicht sechszehn :-(
   Case 6: Select Case tz
                Case 0: my_string = my_string & e(te)
                Case 1: my_string = my_string & z(10) & z(tz) '=sechzehn
                Case Else: my_string = my_string & e(te) & "und" & z(tz)
           End Select
   Case 7: Select Case tz
                Case 0: my_string = my_string & e(te)
                Case 1: my_string = my_string & z(13) & z(tz) '=siebzehn
                Case Else: my_string = my_string & e(te) & "und" & z(tz)
           End Select
   Case Else:
   End Select
 
 'wenn temp>0 muß eventuell noch was an den string
   'angehängt werden, sonst nicht!
   temp = th + tz + te
   
   If temp > 0 Then
   
    Select Case l Mod 2
      Case 1: '...trilliarde, billiarde, milliarde
           If l > 1 Then
             If te = 1 And tz = 0 Then
               my_string = my_string & "e" & d(l)
             Else
               my_string = my_string & d(l) & "n"
             End If
           Else 'tausend
             my_string = my_string & d(l)
           End If
      Case 0: '...trillion, billion, million
         If l > 0 Then
             If te = 1 And tz = 0 Then
               my_string = my_string & "e" & d(l)
             Else
               my_string = my_string & d(l) & "en"
             End If
         Else
             If te = 1 And tz = 0 Then
               my_string = my_string & "s"
             End If
         End If
      Case Else:
    End Select
   End If
Next
inWorten = my_string
End Function