Zahl in Worten (2)
mike49
hatte mich zu früh über die Lösung gefreut. Das Makro zeigt bei negativen Werten immer einen falschen Wert in Worten an.
Wo liegt der Fehler?
| ||||||||||||||||||||||||||||||||||||||||||||||||||
das Makro:
Function inWorten$(wert$) Const Blöcke = 4 'max Anzahl von Dreierblöcken in einer Zahl (z.B. 4 = max bis 999 999 999 999) Dim Block$(Blöcke) Dim text$(Blöcke) Dim Gruppe$(Blöcke) Dim GrEndSg$(Blöcke) Dim GrEndPl$(Blöcke) Dim Einer$(10) Dim Einer2$(10) Dim i%, pos% Dim nk$, TextG$ Einer$(0) = "" Einer$(1) = "eins" Einer$(2) = "zwei" Einer$(3) = "drei" Einer$(4) = "vier" Einer$(5) = "fünf" Einer$(6) = "sechs" Einer$(7) = "sieben" Einer$(8) = "acht" Einer$(9) = "neun" Einer2$(0) = "" Einer2$(1) = "ein" Einer2$(2) = "zwei" Einer2$(3) = "drei" Einer2$(4) = "vier" Einer2$(5) = "fünf" Einer2$(6) = "sech" Einer2$(7) = "sieb" Einer2$(8) = "acht" Einer2$(9) = "neun" Gruppe$(1) = "" Gruppe$(2) = "tausend" Gruppe$(3) = "million" Gruppe$(4) = "milliarde" ' Gruppenendung Singular GrEndSg$(1) = "" GrEndSg$(2) = "" GrEndSg$(3) = "" GrEndSg$(4) = "" ' Gruppenendung Plural GrEndPl$(1) = "" GrEndPl$(2) = "" GrEndPl$(3) = "en" GrEndPl$(4) = "n" For i = 1 To Blöcke Block$(i) = "" text$(i) = "" Next '* Alle Punkte entfernen pos = InStr(wert$, ".") While pos > 0 wert$ = Left$(wert$, pos - 1) + Right$(wert$, Len(wert$) - pos) pos = InStr(pos, wert$, ".") Wend '* Nachkommastellen NK$ schreiben pos = InStr(wert$, ",") If pos > 0 Then nk$ = Right$(wert$, Len(wert$) - pos) wert$ = Left$(wert$, pos - 1) Else nk$ = "" End If For i = 1 To Blöcke If Len(wert$) > 3 Then Block$(i) = Right$(wert$, 3) wert$ = Left$(wert$, Len(wert$) - 3) Else Block$(i) = wert$ wert$ = "" End If If Block$(i) <> "" Then If Len(Block$(i)) = 3 Then If Block$(i) = "000" Then text$(i) = "" ElseIf Left$(Block$(i), 1) = "1" Then text$(i) = "einhundert" ElseIf Left$(Block$(i), 1) = "0" Then text$(i) = "" Else text$(i) = text$(i) + Einer$(Val(Left$(Block$(i), 1))) + "hundert" End If Block$(i) = Right$(Block$(i), 2) End If If Len(Block$(i)) = 2 Then If Left$(Block$(i), 1) = "0" Then text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1))) ElseIf Left$(Block$(i), 1) = "1" Then If Left$(Block$(i), 2) = "11" Then text$(i) = text$(i) + "elf" ElseIf Left$(Block$(i), 2) = "12" Then text$(i) = text$(i) + "zwölf" Else text$(i) = text$(i) + Einer2$(Val(Right$(Block$(i), 1))) + "zehn" End If ElseIf Left$(Block$(i), 1) = "2" Then If Left$(Block$(i), 2) = "21" Then text$(i) = text$(i) + "ein" Else text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1))) End If If Left$(Block$(i), 2) <> "20" Then text$(i) = text$(i) + "und" End If text$(i) = text$(i) + "zwanzig" ElseIf Left$(Block$(i), 1) = "3" Then If Left$(Block$(i), 2) = "31" Then text$(i) = text$(i) + "ein" Else text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1))) End If If Left$(Block$(i), 2) <> "30" Then text$(i) = text$(i) + "und" End If text$(i) = text$(i) + "dreißig" Else If Right$(Block$(i), 1) = "1" Then text$(i) = text$(i) + "ein" Else text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1))) End If If Right$(Block$(i), 1) <> "0" Then text$(i) = text$(i) + "und" End If text$(i) = text$(i) + Einer2$(Val(Left$(Block$(i), 1))) + "zig" End If End If If Len(Block$(i)) = 1 Then text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1))) End If End If If text$(i) <> "" Then End If Next For i = Blöcke To 1 Step -1 If text$(i) <> "" Then If text$(i) = "eins" Then If i > 2 Then text$(i) = "eine" ElseIf i = 2 Then text$(i) = "ein" End If text$(i) = text$(i) + Gruppe$(i) text$(i) = text$(i) + GrEndSg$(i) Else text$(i) = text$(i) + Gruppe$(i) text$(i) = text$(i) + GrEndPl$(i) End If End If TextG$ = TextG$ + text$(i) Next If TextG$ = "" Then TextG$ = " " End If If (nk$ <> "") And (nk$ <> "0") And (nk$ <> "00") Then If Len(nk$) = 1 Then nk$ = nk$ + "0" End If TextG$ = "( in Worten: " + TextG$ + " und " + nk$ + "/100 Euro )" End If If Right$(TextG$, 1) = ")" Then TextG$ = Left$(TextG$, 13) + Chr$(Asc(Mid$(TextG$, 14, 1)) - 32) + Right$(TextG$, Len(TextG$) - 14) Else TextG$ = Chr$(Asc(Left$(TextG$, 1)) - 32) + Right$(TextG$, Len(TextG$) - 1) End If inWorten$ = TextG$ End Function
Gruß
mike49