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 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 Dieser Tipp wurde bereits 21.339 mal aufgerufen.
Anzeige
![]() ![]() ![]() (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
TOP! Unser Nr. 1 ![]() Neu! sevDataGrid 3.0 Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Tipp des Monats ![]() Dieter Otter Beliebige Zeichen am Anfang und Ende eines Strings entfernen Mit der Trim-Funktion lassen sich nicht nur Leerzeichen, sondern bei Bedarf auch beliebige Zeichen entfernen. TOP Entwickler-Paket ![]() TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |