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 Dieser Tipp wurde bereits 32.910 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 sevGraph (VB/VBA) Grafische Auswertungen Präsentieren Sie Ihre Daten mit wenig Aufwand in grafischer Form. sevGraph unterstützt hierbei Balken-, Linien- und Stapel-Diagramme (Stacked Bars), sowie 2D- und 3D-Tortendiagramme und arbeitet vollständig datenbankunabhängig! |
||||||||||||||||
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. |