Word Zahlen in Worte

  • Word

Es gibt 5 Antworten in diesem Thema. Der letzte Beitrag () ist von Marcus Gräfe.

    Word Zahlen in Worte

    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 :)

    ' 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
    @zahleninworte Willkommen im Forum. :thumbup:
    Ich denke mal, es liegt an diesem Code hier:

    Visual Basic-Quellcode

    1. If InStr(Wort, "Ein Millionen") = 1 Then
    2. Wort = "eine Million" + Right(Wort, Len(Wort) - 12)
    3. End If
    Wenn Du Kleinschrift testest, dürfte Dir geholfen sein:
    If InStr(Wort, "ein Millionen") = 1 Then
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!
    Vielen Dank, ich hatte schon alles mögliche ausprobiert, aber dass ich auf die groß/klein-schreibung achte, wäre mir nicht in den Sinn gekommen.
    Funktioniert Super!
    Allerdings Wird jetzt eine Millionn mit 2n ausgegeben

    If InStr(Wort, "ein Millionen") = 1 Then
    Wort = "eine Million" + Right(Wort, Len(Wort) - 12)

    Wenn ich jetzt aber Wort = "eine Millio" + Right(Wort, Len(Wort) -12) schreibe dann wird es korrekt umgewandelt allerdings steht dann bei allen anderen Millionen Zahle z.b.: Zwei Millio ...
    @zahleninworte Nun musst Du anfangen zu lernen, wie man Fehler behebt.
    In VB6 kenn ich mich nicht aus, wie die Entwicklungsumgebung im Debug-Modus funktioniert.
    Die generelle Vorgehensweise ist so:
    Du musst wissen, was jeder Befehl tun soll. Wenn Du das nicht weißt, können wir aufhören. :/
    Setze einen Haltepunkt drauf.
    Wenn das Programm da vorbei kommt, siehst Du Dir den Inhalt der relevanten Variablen an.
    Dann führst Du das Programm im Einzelschrittmodus aus und überprüfst nach jedem Schritt, ob der Inhalt, der in einer Variable steht, genau der ist, der er sein soll.
    Ist er es nicht, hast Du einen Fehler gefunden.
    Im Prinzip musst Du nur feststellen, unter welchen Bedingungen welche Strings zusammengesetzt werden.
    Teste das so, dass nacheinander alle Möglichkeiten in dieser Gruppe durchlaufen werden, d.h., Du musst nicht alle Tausender mit allen Einern kombinieren, es sollte reichen, alle Einer für sich und alle Tausender für sich usw. zu testen.
    Wenn Du Problemfälle hast, solltest Du die nach einer Codeänderung stets immer wieder testen.
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!