AW: Zelleingabe überwachen
GeorgK
Hallo,
folgenden Makro hab ich mal hier im Forum gefunden. Es erstellt eine Funktion, die du über "Einfügen" "Funktion" auswählen kannst. Sie heißt dann Fct_Zahl_in_Worten:
'********************CODE START ********************
Public
Function FctZahl_In_Worten(Zahl As Double)
'wandelt Zahlen im Bereich 1-999.999.999 in Worte um
Dim Z As String, W As String
Dim R As Integer, I As Integer
Z = Int(Zahl)
If Z = 0 Then W = "null": Exit Function
For I = 6 To 0 Step -3
If Len(Z) > I Then
R = Right(Int(Z / (10 ^ I)), 3)
If R > 99 Then W = FctZif(1, Left(R, 1), W) & "hundert": R = Right(R, 2)
If R > 19 Then W = FctZif(3, Right(R, 1), W): W = FctZif(4, Left(R, 1), W)
If I = 0 And Right(Z, 3) Like "00*" And R > 0 Then W = W & "und"
If R < 10 Then W = FctZif(1, Left(R, 1), W)
If R > 9 And R < 20 Then W = FctZif(2, Right(R, 1), W)
If I = 6 And Len(Z) = 7 And R = 1 Then W = "einemillion"
If I = 6 And Right(Int(Z / 10 ^ I), 3) > 1 Then W = W & "millionen"
If I = 3 And Right(Int(Z / 10 ^ I), 3) > 0 Then W = W & "tausend"
If I = 0 And R = 1 Then W = W & "s"
End If
Next
FctZahl_In_Worten = W
End Function
'*************************
Function FctZif(Par As Byte, R As Integer, W As String)
If R = 1 Then W = W & "ein"
If R = 2 Then W = W & "zwei"
If R = 3 Then W = W & "drei"
If R = 4 Then W = W & "vier"
If R = 5 Then W = W & "fünf"
If R = 6 Then W = W & "sech"
If R = 7 Then W = W & "sieb"
If R = 8 Then W = W & "acht"
If R = 9 Then W = W & "neun"
Select Case Par
Case 1, 3
If R = 6 Then W = W & "s"
If R = 7 Then W = W & "en"
If Par = 3 And R > 0 Then W = W & "und"
Case 2
W = W & "zehn"
If R = 1 Then W = Left(W, Len(W) - 7) & "elf"
If R = 2 Then W = Left(W, Len(W) - 8) & "zwölf"
Case 4
If R = 2 Then W = Left(W, Len(W) - 4) & "zwan"
W = W & "zig"
If R = 3 Then W = Left(W, Len(W) - 3) & "ßig"
End Select
FctZif = W
End Function
'********************CODE ENDE ********************
Grüße
GeorgK