Betrag in Worten darstellen Zum automatischen Ausfüllen von Schecks beispielsweise oder beim Drucken von Spendenquittungen muß der Betrag zusätzlich in Worten ausgewiesen werden.
Autor:   Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  32.899
www.tools4vb.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

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

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Zum automatischen Ausfüllen von Schecks beispielsweise oder beim Drucken von Spendenquittungen muß der Betrag zusätzlich in Worten ausgewiesen werden. Die nachfolgende Routine wandelt eine Ganzzahl im Bereich 1 bis 999 Milliarden in Worten um, so daß z.B. für 189 der Text einhundertneunundachtzig ermittelt wird.

Hier der Quellcode:

' Rufen Sie in Ihrem Programm die nachfolgende Routine auf, 
' um eine Ganzzahl in Worten umzuwandeln. Sie übergeben der 
' Funktion einfach die Zahl und erhalten dann den Text als
' String zurück
 
Public Function BetragInWorten(ByVal Betrag As Double) _
  As String
 
  Dim sBetrag As String
  Dim I As Integer
  Dim Gruppe As String
  ReDim tmp1(3) As String
  ReDim tmp2(3) As String
  ReDim Grp(4) As String
 
  If Betrag = 0 Then
    BetragInWorten = "null"
  Else
    tmp1(1) = "einemilliarde": tmp2(1) = "milliarden"
    tmp1(2) = "einemillion": tmp2(2) = "millionen"
    tmp1(3) = "eintausend": tmp2(3) = "tausend"
 
    sBetrag = LTrim$(Str$(Betrag))
    sBetrag = String$(12 - Len(sBetrag), "0") + sBetrag
    For I = 1 To 4
      Gruppe = Mid$(sBetrag, (I - 1) * 3 + 1, 3)
      If Gruppe <> "000" Then
        If I <> 4 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)
  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