Nachfolgende Funktion ist eine Weiterentwicklung des Tipps: 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 Dieser Tipp wurde bereits 15.577 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Neu! sevPopUp 2.0 Dynamische Kontextmenüs! Erstellen Sie mit nur wenigen Zeilen Code Kontextmenüs dynamisch zur Laufzeit. Vordefinierte Styles (XP, Office, OfficeXP, Vista oder Windows 8) erleichtern die Anpassung an die eigenen Anwendung... |
||||||||||||||||
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. |