Hallo,habe noch folgendes gefunden, weiß aber nicht mehr woher ich es habe
Option Explicit
'Zahlen in Worten ausgeben
Dim i%
Function ZWort(Zahl As Double) As String
Dim Teil1$, ATeil$, BTeil$, Rest$
If Fix(Zahl) = 0 Then
If Zahl = 0 Then
ZWort = "null"
Exit Function
Else
ZWort = Format((Zahl - Fix(Zahl)) * 100, "00") & "/100"
Exit Function
End If
End If
If Zahl = Fix(Zahl) Then
Rest = ""
Else
Rest = " " & Format((Zahl - Fix(Zahl)) * 100, "00") & "/100"
End If
If Zahl = 0 Then ZWort = "null": Exit Function
Zahl = Fix(Zahl)
If Zahl = 1 Then ZWort = "eins" & Rest: Exit Function
i = 0
ATeil = Right(Zahl, 3)
ZWort = Hunderter(ATeil)
If Len(Str(Zahl)) < 5 Then GoTo Beenden
Teil1 = ZWort
Zahl = Left(Zahl, Len(Str(Zahl)) - 4)
BTeil = Right(Zahl, 3)
ZWort = Hunderter(BTeil)
If ZWort > "" Then ZWort = ZWort & "tausend"
ZWort = ZWort & Teil1
If Right(ATeil, 3) = 1 Then ZWort = ZWort & "s"
If Len(Str(Zahl)) < 5 Then GoTo Beenden
Teil1 = ZWort
Zahl = Left(Zahl, Len(Str(Zahl)) - 4)
BTeil = Right(Zahl, 3)
ZWort = Hunderter(BTeil)
If BTeil = "1" Then
ZWort = "eine" & "million" & Teil1
Else
If ZWort > "" Then ZWort = ZWort & "millionen"
ZWort = ZWort & Teil1
End If
If Len(Str(Zahl)) < 5 Then GoTo Beenden
Teil1 = ZWort
Zahl = Left(Zahl, Len(Str(Zahl)) - 4)
BTeil = Right(Zahl, 3)
ZWort = Hunderter(BTeil)
If BTeil = "1" Then
ZWort = "eine" & "milliarde" & Teil1
Else
ZWort = ZWort & "milliarden" & Teil1
End If
Beenden:
ZWort = ZWort & Rest
End Function
Function Hunderter(Hteil)
Dim eZahl%, Ziffer1$, Ziffer2$, Ziffer3$
eZahl = Right(Hteil, 1)
Hunderter = Einer(eZahl)
Ziffer3 = Hunderter
If Hteil < 10 Then Exit Function
eZahl = Right(Hteil, 2)
If Right(Hteil, 2) < 20 Then
Hunderter = Zehner(eZahl)
Ziffer1 = Hunderter
If Len(Str(Hteil)) < 4 Then Exit Function
End If
eZahl = Mid(Hteil, Len(Hteil) - 1, 1)
If Hunderter <> "" Then
Hunderter = Hunderter & "und" & Zehner1(eZahl)
Else
Hunderter = Zehner1(eZahl)
Ziffer1 = Hunderter
End If
If Hteil < 100 Then Exit Function
eZahl = Mid(Hteil, Len(Hteil) - 2, 1)
eZahl = Mid(Hteil, Len(Str(Hteil)) - 3, 1)
If Right(Hteil, 2) < 10 Then
If Mid(Hteil, 2, 1) = 0 And Right(Hteil, 1) = 1 Then
Hunderter = Einer(eZahl) & "hunderteins"
Else
Hunderter = Einer(eZahl) & "hundert" & Ziffer3
End If
ElseIf Right(Hteil, 2) > 9 And Right(Hteil, 2) < 20 Then
Hunderter = Einer(eZahl) & "hundert" & Ziffer1
Else
Hunderter = Einer(eZahl) & "hundert" & Hunderter
End If
End Function
Function Einer(EinerZahl)
Select Case EinerZahl
' Case Is = 0
' Einer = "null"
Case Is = 1
Einer = "ein"
Case Is = 2
Einer = "zwei"
Case Is = 3
Einer = "drei"
Case Is = 4
Einer = "vier"
Case Is = 5
Einer = "fünf"
Case Is = 6
Einer = "sechs"
Case Is = 7
Einer = "sieben"
Case Is = 8
Einer = "acht"
Case Is = 9
Einer = "neun"
End Select
End Function
Function Zehner(ZehnerZahl)
Select Case ZehnerZahl
Case Is = 10
Zehner = "zehn"
Case Is = 11
Zehner = "elf"
Case Is = 12
Zehner = "zwölf"
Case Is = 13
Zehner = "dreizehn"
Case Is = 14
Zehner = "vierzehn"
Case Is = 15
Zehner = "fünfzehn"
Case Is = 16
Zehner = "sechzehn"
Case Is = 17
Zehner = "siebzehn"
Case Is = 18
Zehner = "achtzehn"
Case Is = 19
Zehner = "neunzehn"
End Select
End Function
Function Zehner1(ZehnerZahl)
Select Case ZehnerZahl
Case Is = 2
Zehner1 = "zwanzig"
Case Is = 3
Zehner1 = "dreißig"
Case Is = 4
Zehner1 = "vierzig"
Case Is = 5
Zehner1 = "fünfzig"
Case Is = 6
Zehner1 = "sechzig"
Case Is = 7
Zehner1 = "siebzig"
Case Is = 8
Zehner1 = "achtzig"
Case Is = 9
Zehner1 = "neunzig"
End Select
End Function