Beispiel:

Option Explicit
 
Public Function NumberToWord(ByVal lNumber As Long, _
       Optional bWithDashes As Boolean = True) As String
'// --------------------------------------------------------
'// Methode:  | Konvertiert eine Zahl in ein Wort
'// --------------------------------------------------------
'// Parameter:| lNumber    -zu konvertierende Ganzzahl
'//           | bWithDashes-steuert einschließende Striche
'// -------------------------------------------------------
'// Rückgabe: | konvertierte Zahl
'// --------------------------------------------------------
'// Beispiel: |?NumberToWord(1658)
'//           |--- Einstausendsechshundertachtundfünfzig ---
'// --------------------------------------------------------
'// Autor:    | Stefan Kulpa
'//           | EDV Innovation & Consulting - Dormagen
'// --------------------------------------------------------
    Dim sNumber     As String
    Dim lThousand   As Long
    Dim iMillion    As Long
    Dim lSingle     As Long
 
    On Error Resume Next
    sNumber = Format$(lNumber, "000000000")
    If Len(sNumber) > 9 Then
        NumberToWord = "***"
        Exit Function
    End If
 
    iMillion = CInt(Left$(sNumber, 3))
    lThousand = CInt(Mid$(sNumber, 4, 3))
    lSingle = CInt(Right$(sNumber, 3))
 
    NumberToWord = "--- " & BlockToWords(iMillion)
    If iMillion > 0 Then
        NumberToWord = NumberToWord & "millionen"
    End If
    NumberToWord = NumberToWord & BlockToWords(lThousand)
    If lThousand > 0 Then
        NumberToWord = NumberToWord & "tausend"
    End If
 
    NumberToWord = NumberToWord & BlockToWords(lSingle)
    If Right$(LCase(NumberToWord), 3) = "ein" Then
        NumberToWord = Replace(NumberToWord, "ein", "eins")
    End If
 
    NumberToWord = _
    StrConv(NumberToWord & " ---", vbProperCase)
 
    If Not bWithDashes Then
        NumberToWord = Trim(Replace(NumberToWord, "-", ""))
    End If
 
End Function
 
Private Function BlockToWords _
                (ByVal lBlock As Long) As String
 
    Dim l1              As Long
    Dim l2              As Long
    Dim l3              As Long
    Dim asNumber(12)    As String
 
    On Error Resume Next
    asNumber(0) = "": asNumber(1) = "ein"
    asNumber(2) = "zwei": asNumber(3) = "drei"
    asNumber(4) = "vier": asNumber(5) = "fünf"
    asNumber(6) = "sechs": asNumber(7) = "sieben"
    asNumber(8) = "acht": asNumber(9) = "neun"
    asNumber(10) = "zehn": asNumber(11) = "elf"
    asNumber(12) = "zwölf"
 
    l1 = lBlock \ 100
    l2 = (lBlock - l1 * 100) \ 10
    l3 = lBlock - l1 * 100 - l2 * 10
 
    BlockToWords = asNumber(l1)
    If l1 > 0 Then BlockToWords = _
                   BlockToWords & "hundert"
 
    Select Case l2 * 10 + l3
        Case 1:
        BlockToWords = BlockToWords & "ein"
        Case 2 To 12:
        BlockToWords = BlockToWords & asNumber(l2 * 10 + l3)
        Case 13 To 19:
        BlockToWords = _
        BlockToWords & _
                    Choose(l2 * 10 + l3 - 12, "dreizehn", _
                    "vierzehn", "fünfzehn", "sechzehn", _
                    "siebzehn", "achtzehn", "neunzehn")
        Case Is > 19:
        BlockToWords = BlockToWords & asNumber(l3)
        If (l2 * 10 + l3) Mod 10 <> 0 Then
            BlockToWords = BlockToWords & "und"
            BlockToWords = _
            BlockToWords & _
                    Choose(l2 - 1, "zwanzig", "dreißig", _
                    "vierzig", "fünfzig", "sechzig", _
                    "siebzig", "achtzig", "neunzig")
        Else
            BlockToWords = _
            BlockToWords & _
                    Choose(l2 - 1, "zwanzig", "dreißig", _
                    "vierzig", "fünfzig", "sechzig", _
                    "siebzig", "achtzig", "neunzig")
        End If
    End Select
 
End Function