Rubrik: Variablen/Strings · Sonstiges | VB-Versionen: VB4, VB5, VB6 | 29.07.02 |
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: | Views: 21.260 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
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