Hallo, ich habe im Internet ein Skript gefunden dass mir Beträge in den wortlaut umwandelt.
Es funktioniert alles einwandfrei allerdings die Zahlen von 1000000-199999 werden mit Ein MIllionen statt eine Million angezeigt.
Wenn mir evtl noch jemand tipps geben könnte was ich machen muss um zb. man schreibt nur 1000 und durch das makro dann 1000 in Worten "eintausend"
wäre toll wenn mir jemand helfen könnte
Es funktioniert alles einwandfrei allerdings die Zahlen von 1000000-199999 werden mit Ein MIllionen statt eine Million angezeigt.
Wenn mir evtl noch jemand tipps geben könnte was ich machen muss um zb. man schreibt nur 1000 und durch das makro dann 1000 in Worten "eintausend"
wäre toll wenn mir jemand helfen könnte
' Diese Word 97/2k-Funktion gibt (Geld)beträge in Worten aus
' Erstellt am 11/02/99 von René Probst / eku / CH-8152 Glattbrugg
'
' Der Name des Makro lautet: BetragInWorteUmwandeln
' Markieren Sie einen Betrag in Ihrem Dokument und rufen Sie die Routine auf.
'
' Verarbeitet Beträge zwischen -999'999'999 und 999'999'999
'
' * * * * * * * * * Landspezifische Einstellungen * * * * * * * * * *
Private Const DZeichen = "," 'Dezimalzeichen
Private Const Dreissig = "dreißig" 'dreissig = CH; dreißig = D / A
Private Const Fünfer = 0 '0: auf ein Pfennig/Groschen genau;
' 1: auf fünf Rappen genau
' * * * * * * * * * Ende Landspezifische Einstellungen * * * * * * * *
'
Private Const Hundertstel = 0 '0: Pfennige/Groschen/Rappen werden nicht einbezogen;
' 1: werden einbezogen
' 2: werden einbezogen aber nicht bei 00
Private Const Prozent = 0 '0: Format 00/100;
' 1 = % plus Nachkommastellen
Private Const Vorzeichen = 1 '0: Minus als Vorzeichen wird nicht gezeigt;
' 1: wird angezeigt
Private Const GSchreibung = 1 '0: 1. Buchstaben klein geschrieben;
' 1: 1. Buchstaben gross geschrieben
Dim Wort As String
Private Const Titel = "Zahlen in Worten"
Sub BetragInWorteUmwandeln()
If Selection.Type <> wdSelectionNormal Then
MsgBox "Markieren Sie einen Betrag.", , Titel
End
End If
x = Selection.Text
If Right(x, 1) = Chr(13) Then x = Left(x, Len(x) - 1)
If Not IsNumeric(x) Then
MsgBox "Der markierte Text ist kein gültiger Betrag.", , Titel
End
End If
Selection.Text = InWorten(x)
End Sub
Private Function InWorten(ByVal Betrag As Double) As String
Vorz = ""
If Vorzeichen = 1 And Betrag < 0 Then Vorz = "- "
If Abs(Betrag) > (1000000000 - 0.006) Then
InWorten = "Ungültig!"
Exit Function
End If
If Betrag < 0 Then Betrag = Betrag * -1
ZahlenInWorten Betrag
InWorten = Vorz & Wort
If GSchreibung = 1 Then
InWorten = Vorz & UCase(Left(Wort, 1)) + Right(Wort, Len(Wort) - 1)
End If
End Function
Private Sub ZahlenInWorten(Betrag)
Wort = ""
GanzBetrag = Betrag
Betrag = Format(Betrag, "#.00")
If InStr(Betrag, DZeichen) > 0 Then Betrag = Left(Betrag, InStr(Betrag, DZeichen) - 1)
Länge = Len(Betrag)
Max = Länge \ 3
tmp = Länge Mod 3
If tmp > 0 Then Max = Max + 1
ReDim Tbetr(Max)
tmp = Betrag
For i = Max To 1 Step -1 'Bilden von 3-er Paketen von rechts aus gesehen
Tbetr(i) = Right(tmp, 3)
If Len(tmp) > 3 Then tmp = Left(tmp, Len(tmp) - 3)
Next i
i = 1
For i = 1 To Max ' Alle 3-er Pakete verarbeiten
Lg = Len(Tbetr(i))
If i = Max Then Flag = True Else Flag = False
If Lg = 1 Then Wort = GetEiner(Right(Tbetr(i), 1))
If Lg = 2 Then Wort = Wort + GetZehner(Mid(Tbetr(i), Lg - 1, 1), Tbetr(i))
If Lg = 3 Then Wort = Wort + GetHunderter(Mid(Tbetr(i), Lg - 2, 1), Tbetr(i), Flag)
If Tbetr(i) > 0 And Betrag > 999 Then
If (Max - i) = 1 Then Wort = Wort + "tausend"
If (Max - i) = 2 Then Wort = Wort + " Millionen "
End If
Next i
If InStr(Wort, "Ein Millionen") = 1 Then
Wort = "eine Million" + Right(Wort, Len(Wort) - 12)
End If
If Right(Wort, 3) = "ein" Then Wort = Left(Wort, Len(Wort) - 3) + "eins"
If Hundertstel > 0 Then Wort = Wort + GetHundertstel(GanzBetrag)
End Sub
Private Function GetEiner(Zahl)
Select Case Zahl
Case 0: Z = "null"
Case 1: Z = "ein"
Case 2: Z = "zwei"
Case 3: Z = "drei"
Case 4: Z = "vier"
Case 5: Z = "fünf"
Case 6: Z = "sechs"
Case 7: Z = "sieben"
Case 8: Z = "acht"
Case 9: Z = "neun"
End Select
GetEiner = Z
End Function
Private Function GetZehner(Zahl, Betrag)
Betrag = Right(Betrag, 2)
Select Case Betrag
Case 10: Z = "zehn"
Case 11: Z = "elf"
Case 12: Z = "zwölf"
Case 13, 14, 15, 18, 19: Z = GetEiner(Right(Betrag, 1)) + "zehn"
Case 16: Z = "sechzehn"
Case 17: Z = "siebzehn"
Case 20: Z = "zwanzig"
Case 21 To 29: Z = GetEiner(Right(Betrag, 1)) + "undzwanzig"
Case 30: Z = Dreissig
Case 31 To 39: Z = GetEiner(Right(Betrag, 1)) + "und" + Dreissig
Case 40: Z = "vierzig"
Case 41 To 49: Z = GetEiner(Right(Betrag, 1)) + "undvierzig"
Case 50: Z = "fünfzig"
Case 51 To 59: Z = GetEiner(Right(Betrag, 1)) + "undfünfzig"
Case 60: Z = "sechzig"
Case 61 To 69: Z = GetEiner(Right(Betrag, 1)) + "undsechzig"
Case 70: Z = "siebzig"
Case 71 To 79: Z = GetEiner(Right(Betrag, 1)) + "undsiebzig"
Case 80: Z = "achtzig"
Case 81 To 89: Z = GetEiner(Right(Betrag, 1)) + "undachtzig"
Case 90: Z = "neunzig"
Case 91 To 99: Z = GetEiner(Right(Betrag, 1)) + "undneunzig"
End Select
GetZehner = Z
End Function
Private Function GetHunderter(Zahl, Betrag, Flag)
If Zahl > 0 Then y = GetEiner(Zahl) + "hundert"
Select Case Right(Betrag, 2)
Case 0: Z = ""
Case 1 To 9: Z = GetEiner(Right(Betrag, 1))
Case Else: Z = GetZehner(Zahl, Betrag)
End Select
If Flag = True And Betrag > 0 And Zahl = 0 Then
GetHunderter = y + Z
Else
GetHunderter = y + Z
End If
End Function
Private Function GetHundertstel(Betrag)
If Fünfer = 1 Then
Betrag = Format((Betrag * 20 + 0.5) / 20, "#.00")
Else
Betrag = Format(Betrag, "") 'Format(Betrag, "#.00")
End If
If Prozent = 1 Then
P1 = "%"
P2 = ""
Else
P1 = " "
P2 = "/100"
End If
GetHundertstel = P1 + Right(Betrag, 2) + P2
End Function
' Erstellt am 11/02/99 von René Probst / eku / CH-8152 Glattbrugg
'
' Der Name des Makro lautet: BetragInWorteUmwandeln
' Markieren Sie einen Betrag in Ihrem Dokument und rufen Sie die Routine auf.
'
' Verarbeitet Beträge zwischen -999'999'999 und 999'999'999
'
' * * * * * * * * * Landspezifische Einstellungen * * * * * * * * * *
Private Const DZeichen = "," 'Dezimalzeichen
Private Const Dreissig = "dreißig" 'dreissig = CH; dreißig = D / A
Private Const Fünfer = 0 '0: auf ein Pfennig/Groschen genau;
' 1: auf fünf Rappen genau
' * * * * * * * * * Ende Landspezifische Einstellungen * * * * * * * *
'
Private Const Hundertstel = 0 '0: Pfennige/Groschen/Rappen werden nicht einbezogen;
' 1: werden einbezogen
' 2: werden einbezogen aber nicht bei 00
Private Const Prozent = 0 '0: Format 00/100;
' 1 = % plus Nachkommastellen
Private Const Vorzeichen = 1 '0: Minus als Vorzeichen wird nicht gezeigt;
' 1: wird angezeigt
Private Const GSchreibung = 1 '0: 1. Buchstaben klein geschrieben;
' 1: 1. Buchstaben gross geschrieben
Dim Wort As String
Private Const Titel = "Zahlen in Worten"
Sub BetragInWorteUmwandeln()
If Selection.Type <> wdSelectionNormal Then
MsgBox "Markieren Sie einen Betrag.", , Titel
End
End If
x = Selection.Text
If Right(x, 1) = Chr(13) Then x = Left(x, Len(x) - 1)
If Not IsNumeric(x) Then
MsgBox "Der markierte Text ist kein gültiger Betrag.", , Titel
End
End If
Selection.Text = InWorten(x)
End Sub
Private Function InWorten(ByVal Betrag As Double) As String
Vorz = ""
If Vorzeichen = 1 And Betrag < 0 Then Vorz = "- "
If Abs(Betrag) > (1000000000 - 0.006) Then
InWorten = "Ungültig!"
Exit Function
End If
If Betrag < 0 Then Betrag = Betrag * -1
ZahlenInWorten Betrag
InWorten = Vorz & Wort
If GSchreibung = 1 Then
InWorten = Vorz & UCase(Left(Wort, 1)) + Right(Wort, Len(Wort) - 1)
End If
End Function
Private Sub ZahlenInWorten(Betrag)
Wort = ""
GanzBetrag = Betrag
Betrag = Format(Betrag, "#.00")
If InStr(Betrag, DZeichen) > 0 Then Betrag = Left(Betrag, InStr(Betrag, DZeichen) - 1)
Länge = Len(Betrag)
Max = Länge \ 3
tmp = Länge Mod 3
If tmp > 0 Then Max = Max + 1
ReDim Tbetr(Max)
tmp = Betrag
For i = Max To 1 Step -1 'Bilden von 3-er Paketen von rechts aus gesehen
Tbetr(i) = Right(tmp, 3)
If Len(tmp) > 3 Then tmp = Left(tmp, Len(tmp) - 3)
Next i
i = 1
For i = 1 To Max ' Alle 3-er Pakete verarbeiten
Lg = Len(Tbetr(i))
If i = Max Then Flag = True Else Flag = False
If Lg = 1 Then Wort = GetEiner(Right(Tbetr(i), 1))
If Lg = 2 Then Wort = Wort + GetZehner(Mid(Tbetr(i), Lg - 1, 1), Tbetr(i))
If Lg = 3 Then Wort = Wort + GetHunderter(Mid(Tbetr(i), Lg - 2, 1), Tbetr(i), Flag)
If Tbetr(i) > 0 And Betrag > 999 Then
If (Max - i) = 1 Then Wort = Wort + "tausend"
If (Max - i) = 2 Then Wort = Wort + " Millionen "
End If
Next i
If InStr(Wort, "Ein Millionen") = 1 Then
Wort = "eine Million" + Right(Wort, Len(Wort) - 12)
End If
If Right(Wort, 3) = "ein" Then Wort = Left(Wort, Len(Wort) - 3) + "eins"
If Hundertstel > 0 Then Wort = Wort + GetHundertstel(GanzBetrag)
End Sub
Private Function GetEiner(Zahl)
Select Case Zahl
Case 0: Z = "null"
Case 1: Z = "ein"
Case 2: Z = "zwei"
Case 3: Z = "drei"
Case 4: Z = "vier"
Case 5: Z = "fünf"
Case 6: Z = "sechs"
Case 7: Z = "sieben"
Case 8: Z = "acht"
Case 9: Z = "neun"
End Select
GetEiner = Z
End Function
Private Function GetZehner(Zahl, Betrag)
Betrag = Right(Betrag, 2)
Select Case Betrag
Case 10: Z = "zehn"
Case 11: Z = "elf"
Case 12: Z = "zwölf"
Case 13, 14, 15, 18, 19: Z = GetEiner(Right(Betrag, 1)) + "zehn"
Case 16: Z = "sechzehn"
Case 17: Z = "siebzehn"
Case 20: Z = "zwanzig"
Case 21 To 29: Z = GetEiner(Right(Betrag, 1)) + "undzwanzig"
Case 30: Z = Dreissig
Case 31 To 39: Z = GetEiner(Right(Betrag, 1)) + "und" + Dreissig
Case 40: Z = "vierzig"
Case 41 To 49: Z = GetEiner(Right(Betrag, 1)) + "undvierzig"
Case 50: Z = "fünfzig"
Case 51 To 59: Z = GetEiner(Right(Betrag, 1)) + "undfünfzig"
Case 60: Z = "sechzig"
Case 61 To 69: Z = GetEiner(Right(Betrag, 1)) + "undsechzig"
Case 70: Z = "siebzig"
Case 71 To 79: Z = GetEiner(Right(Betrag, 1)) + "undsiebzig"
Case 80: Z = "achtzig"
Case 81 To 89: Z = GetEiner(Right(Betrag, 1)) + "undachtzig"
Case 90: Z = "neunzig"
Case 91 To 99: Z = GetEiner(Right(Betrag, 1)) + "undneunzig"
End Select
GetZehner = Z
End Function
Private Function GetHunderter(Zahl, Betrag, Flag)
If Zahl > 0 Then y = GetEiner(Zahl) + "hundert"
Select Case Right(Betrag, 2)
Case 0: Z = ""
Case 1 To 9: Z = GetEiner(Right(Betrag, 1))
Case Else: Z = GetZehner(Zahl, Betrag)
End Select
If Flag = True And Betrag > 0 And Zahl = 0 Then
GetHunderter = y + Z
Else
GetHunderter = y + Z
End If
End Function
Private Function GetHundertstel(Betrag)
If Fünfer = 1 Then
Betrag = Format((Betrag * 20 + 0.5) / 20, "#.00")
Else
Betrag = Format(Betrag, "") 'Format(Betrag, "#.00")
End If
If Prozent = 1 Then
P1 = "%"
P2 = ""
Else
P1 = " "
P2 = "/100"
End If
GetHundertstel = P1 + Right(Betrag, 2) + P2
End Function