von Stephan » Mo, 04.02.2013 19:41
Kann mir jemand helfen?
Wobei? Das Makro funktioniert unverändert auch wennn Du die entsprechende xls-Datei in Calc öffnest.
Falls Du keine xls-Datei hast und gleich eine Calc-Datei erstellen willst reicht es die Kompatibilitätsoption (Option VBASupport 1) vor die errste Funktion zu schreiben:
Code: Alles auswählen
Option VBASupport 1
'*********** CODE START *************
Public Function FctZahl_In_Worten(Zahl As Double)
'wandelt Zahlen im Bereich 0-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 FctZahl_In_Worten = "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, r, 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)
w = w & Choose(r, "ein", "zwei", "drei", "vier", "fünf", "sech", "sieb", "acht", "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
Gruß
Stephan
[quote]Kann mir jemand helfen?[/quote]
Wobei? Das Makro funktioniert unverändert auch wennn Du die entsprechende xls-Datei in Calc öffnest.
Falls Du keine xls-Datei hast und gleich eine Calc-Datei erstellen willst reicht es die Kompatibilitätsoption (Option VBASupport 1) vor die errste Funktion zu schreiben:
[code]Option VBASupport 1
'*********** CODE START *************
Public Function FctZahl_In_Worten(Zahl As Double)
'wandelt Zahlen im Bereich 0-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 FctZahl_In_Worten = "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, r, 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)
w = w & Choose(r, "ein", "zwei", "drei", "vier", "fünf", "sech", "sieb", "acht", "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]
Gruß
Stephan