Betrag in Worten darstellen (mit Kommastellen) Zum automatischen Ausfüllen von Schecks beispielsweise oder beim Drucken von Spendenquittungen muß der Betrag zusätzlich in Worten ausgewiesen werden.
Autor:   Robert Gamweger	Bewertung:     [ Jetzt bewerten ]	Views:  21.400
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 21 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.8 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Rufen Sie in Ihrem Programm die nachfolgende Routine auf, um eine Kommazahl in Worten umzuwandeln. Sie übergeben der Funktion einfach die Zahl und erhalten dann den Text als String zurück bis maximal (neunhundertneunzigbillionen..)=15 Stellen.

Original von Dieter Otter
 Betrag in Worten darstellen

Erweitert von Robert Gamweger für Kommastellenausgabe.

Public Function BetragInWorten(ByVal Betrag As Double) _
  As String
 
  Dim sBetrag As String
  Dim kBetrag As Single     ' Betrag hinter dem Komma
  Dim I As Integer
  Dim Gruppe As String
  Dim sKomma As String
  ReDim tmp1(4) As String
  ReDim tmp2(4) As String
  ReDim Grp(5) As String
 
  kBetrag = Betrag - Fix(Betrag)
  If kBetrag > 0 Then
    sKomma = "komma"
    sBetrag = Mid(kBetrag, 3)
    While Left(sBetrag, 1) = "0"
      sKomma = sKomma & "null"
      sBetrag = Mid(sBetrag, 2)
    Wend
    sKomma = sKomma & BetragInWorten(CLng(sBetrag))
  End If
 
  Betrag = Fix(Betrag)  ' Zahl ohne Komma erstellen
  If Betrag = 0 Then
    BetragInWorten = "null" & sKomma
  Else
    tmp1(1) = "einebillion": tmp2(1) = "billionen"
    tmp1(2) = "einemilliarde": tmp2(2) = "milliarden"
    tmp1(3) = "einemillion": tmp2(3) = "millionen"
    tmp1(4) = "eintausend": tmp2(4) = "tausend"
 
    sBetrag = LTrim$(Str$(Betrag))
    sBetrag = Left(sBetrag, 15)
    sBetrag = String$(15 - Len(sBetrag), "0") + sBetrag
    For I = 1 To 5
      Gruppe = Mid$(sBetrag, (I - 1) * 3 + 1, 3)
      If Gruppe <> "000" Then
        If I <> 5 Then
          If Gruppe = "001" Then
            Grp(I) = tmp1(I)
          Else
            Grp(I) = GetGruppe(Gruppe) + tmp2(I)
          End If
        Else
          Grp(I) = GetGruppe(Gruppe)
        End If
      End If
    Next I
    BetragInWorten = Grp(1) + Grp(2) + Grp(3) + _
      Grp(4) + Grp(5) & sKomma
  End If
End Function
 
' Die nachfolgende Funktion wird von der Hauptfunktion 
' aufgerufen
Private Function GetGruppe(ByVal Gruppe As String) As String
 
  ' Dreiergruppen in Worten zusammenfassen
 
  Dim Hunderter As String
  Dim Zehner As String
  Dim Einer As String
 
  ' Hunderterstellen
  If Val(Mid$(Gruppe, 1, 1)) > 0 Then
    If Mid$(Gruppe, 1, 1) = "1" Then
      Hunderter = "einhundert"
    Else
      Hunderter = Choose(Val(Mid$(Gruppe, 1, 1)) + 1, "null", _
        "eins", "zwei", "drei", "vier", "fünf", "sechs", _
        "sieben", "acht", "neun") + "hundert"
    End If
  End If
 
  ' Zehnerstellen
  If Val(Right$(Gruppe, 2)) >= 10 And _
    Val(Right$(Gruppe, 2)) < 20 Then
    Einer = Choose(Val(Right$(Gruppe, 2)) - 9, "zehn", "elf", _
      "zwölf", "dreizehn", "vierzehn", "fünfzehn", "sechzehn", _
      "siebzehn", "achtzehn", "neunzehn")
  Else
    If Val(Mid$(Gruppe, 2, 1)) > 1 Then
      Zehner = Choose(Val(Mid$(Gruppe, 2, 1)) - 1, "zwanzig", _
        "dreißig", "vierzig", "fünfzig", "sechzig", "siebzig", _
        "achtzig", "neunzig")
    End If
    If Val(Mid$(Gruppe, 3, 1)) > 0 Then
      ' Einerstellen
      If Zehner = "" Then
        Einer = Choose(Val(Mid$(Gruppe, 3, 1)) + 1, "null", _
          "eins", "zwei", "drei", "vier", "fünf", "sechs", _
          "sieben", "acht", "neun")
      Else
        If Mid$(Gruppe, 3, 1) = "1" Then
          Einer = "einund"
        Else
          Einer = Choose(Val(Mid$(Gruppe, 3, 1)) + 1, "null", _
            "eins", "zwei", "drei", "vier", "fünf", "sechs", _
            "sieben", "acht", "neun") + "und"
        End If
      End If
    End If
  End If
 
  GetGruppe = Hunderter + Einer + Zehner
End Function