Rubrik: Variablen/Strings · Sonstiges | VB-Versionen: VB4, VB5, VB6 | 06.02.04 |
Betrag in Worten darstellen (mit Kommastellen+Anz) Funktion, um eine Kommazahl in Worten umzuwandeln. Die Ausgabe der Kommastellen kann individuell festgelegt werden. | ||
Autor: Robert Gamweger | Bewertung: | Views: 15.583 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Nachfolgende Funktion ist eine Weiterentwicklung des Tipps:
Betrag in Worten darstellen (mit Kommastellen)
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..)=15stellen. Der Parameter "Stellen" gibt an, wie der Wert nach der Kommastelle gesprochen werden sollte: z.B. BetragInWorten(1.1)=einskommaeins oder BetragInWorten(1.1, 2)=einskommazehn.
' Original von Dieter Otter: http://www.tools4vb.de ' Erweitert von Robert Gamweger für Kommastellenausgabe ' Nochmals erweitert um den Parameter Stellen, ' damit die Anzahl der gewünschten Kommastellen ' bestimmt werden kann. Public Function BetragInWorten(ByVal Betrag As Double, _ Optional Stellen As Byte = 0) As String Dim sKoma As String ' String nach komma Dim sBetrag As String Dim kBetrag As Single ' Betrag hinter dem Komma Dim i As Integer Dim Gruppe As String ReDim tmp1(4) As String ReDim tmp2(4) As String ReDim Grp(5) As String kBetrag = Betrag - Fix(Betrag) If kBetrag > 0 Or Stellen > 0 Then sKoma = "komma" sBetrag = Mid(kBetrag, 3) i = Stellen - Len(sBetrag) If i > 0 Then sBetrag = sBetrag & String(i, "0") While Left(sBetrag, 1) = "0" sKoma = sKoma & "null" sBetrag = Mid(sBetrag, 2) Wend If sBetrag <> "" Then sKoma = sKoma & BetragInWorten(CLng(sBetrag)) End If End If Betrag = Fix(Betrag) ' Zahl ohne Komma erstellen If Betrag = 0 Then BetragInWorten = "null" & sKoma 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) & sKoma 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