' ############################################################
' #                    Zahl in Text                          #
' #       Zahl markieren, Makro starten                      #
' #       Die Zahl in Worten ist in der Zwischenablage       #
' #       und kann beliebig eingefügt werden                 #
' #                                                          #
' #        Irmgard Schwenteck, 2003  iw @ 4haus.de           #
' ############################################################

Function ZahlinWort(Betrag As Long) As String
Dim zahlw As String
Dim l As Integer, i As Integer, j As Integer
Dim z As String, h As String
Dim zahl(1 To 3, 1 To 3) As String
    
    zahlw = Trim(CStr(Betrag))
    If Len(zahlw) = 0 Or zahlw = "0" Then
        ZahlinWort = "Null"
        GoTo ende
    End If
    i = 3: j = 3
    For l = 9 To 1 Step -1
        If Len(zahlw) > 0 Then
            z = Right(zahlw, 1)
            Select Case z
            Case "1"
                zahl(i, j) = "ein"
            Case "2"
                zahl(i, j) = "zwei"
            Case "3"
                zahl(i, j) = "drei"
            Case "4"
                zahl(i, j) = "vier"
            Case "5"
                zahl(i, j) = "fünf"
            Case "6"
                zahl(i, j) = "sechs"
            Case "7"
                zahl(i, j) = "sieben"
            Case "8"
                zahl(i, j) = "acht"
            Case "9"
                zahl(i, j) = "neun"
            Case Else
                zahl(i, j) = ""
            End Select
            zahlw = Mid(zahlw, 1, Len(zahlw) - 1)
            j = j - 1
            If j = 0 Then
                j = 3
                i = i - 1
            End If
        Else
            zahl(i, j) = ""
        End If
    Next l
    
    For i = 1 To 3
        If zahl(i, 1) <> "" Then h = zahl(i, 1) & "hundert"
        Select Case zahl(i, 2)
        Case "ein"
            z = "zehn"
        Case "zwei"
            z = "undzwanzig"
        Case "drei"
            z = "unddreißig"
        Case "vier"
            z = "undvierzig"
        Case "fünf"
            z = "undfünfzig"
        Case "sechs"
            z = "undsechzig"
        Case "sieben"
            z = "undsiebzig"
        Case "acht"
            z = "undachtzig"
        Case "neun"
            z = "undneunzig"
        Case Else
            z = ""
        End Select
        z = zahl(i, 3) & z
        Select Case z
        Case "einzehn"
            z = "elf"
        Case "zweizehn"
            z = "zwölf"
        Case "sechszehn"
            z = "sechzehn"
        Case "siebenzehn"
            z = "siebzehn"
        End Select
        h = h & z
        If h <> "" Then
            Select Case i
            Case 1
                If z = "ein" Then
                    h = h & "emillion"
                Else
                    h = h & "millionen"
                End If
            Case 2
                h = h & "tausend"
            End Select
        End If
        ZahlinWort = ZahlinWort & h
        h = ""
        z = ""
    Next i
    If Mid(ZahlinWort, 1, 3) = "und" Then
        ZahlinWort = Mid(ZahlinWort, 4, 256)
    End If
    ZahlinWort = UCase(Left(ZahlinWort, 1)) & Mid(ZahlinWort, 2, 256)
ende:
End Function

Public Sub ZahlinText()
Dim t As String
Dim i As Long, d As Double
Dim ausgabe As String
Dim Betrag1 As Long
Dim Betr2 As String
Dim ausgabetext As DataObject
Const Curr = "Euro"

    With Selection.Find
        .ClearFormatting
        .MatchWholeWord = True
        .MatchCase = False
        .Execute FindText:=".", ReplaceWith:="", Replace:=wdReplaceAll
    End With
    t = Selection.Text
' wenn keine Zahl rauskommt, dann gleich Ende
    If Not IsNumeric(t) Then Exit Sub

 'Zahl mit Kommastellen?
    i = InStr(t, ",")
    If i > 0 Then
        d = Round(CDbl(t), 2)
        t = CStr(d)
        Betrag1 = CLng(Left(t, i - 1))
        Betr2 = Trim(Mid(t, i + 1, 50))
    Else
        Betrag1 = CLng(t)
        Betr2 = "00"
    End If
    If Len(Betr2) = 1 Then
        Betr2 = "0" & Betr2
    End If
    ausgabe = ZahlinWort(Betrag1) & " " & Betr2 & "/100 " & Curr
    Set ausgabetext = New DataObject
    ausgabetext.SetText ausgabe
    ausgabetext.PutInClipboard
    With Selection.Find
        .ClearFormatting
        .MatchWholeWord = True
        .MatchCase = False
        .Execute FindText:=",", ReplaceWith:=".", Replace:=wdReplaceAll
    End With
    t = Selection.Text
    Selection.Text = Format(Val(t), "##,##0.00")
End Sub