Hallo,
habe ein schönes Makro gefunden, das eine Zahl in Worten wiederholt. Wie müsste man es verändern, dass die Wortwiederholung immer mit Großbuchstaben beginnt?
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) 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$ = "null" 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 ' TextG$ = Chr$(Asc(Left$(TextG$, 1)) - 32) + Right$(TextG$, Len(TextG$) - 1) inWorten$ = TextG$ End Function
Gruß mike49