Snippet Library

none

'
' Found on the net somewhere - apologies to author
'
Private Function NumToText(dblVal As Double) As String
    Static sOnes(0 To 9) As String
    Static sTeens(0 To 9) As String
    Static sTens(0 To 9) As String
    Static sThousands(0 To 4) As String
    Static bInit As Boolean
    
    Dim i As Integer
    Dim bAllZeros As Boolean
    Dim bShowsThousands As Boolean
    Dim sValue As String
    Dim sBuffer As String
    Dim sTemp As String
    Dim iCol As Integer
    Dim iChar As Integer
'
' Warning - this routine only handles positive values
'
    Debug.Assert dblVal > 0
    
    If bInit = False Then
        'Initialize array
        bInit = True
        sOnes(0) = "zero"
        sOnes(1) = "one"
        sOnes(2) = "two"
        sOnes(3) = "three"
        sOnes(4) = "four"
        sOnes(5) = "five"
        sOnes(6) = "six"
        sOnes(7) = "seven"
        sOnes(8) = "eight"
        sOnes(9) = "nine"
        sTeens(0) = "ten"
        sTeens(1) = "eleven"
        sTeens(2) = "twelve"
        sTeens(3) = "thirteen"
        sTeens(4) = "fourteen"
        sTeens(5) = "fifteen"
        sTeens(6) = "sixteen"
        sTeens(7) = "seventeen"
        sTeens(8) = "eighteen"
        sTeens(9) = "nineteen"
        sTens(0) = ""
        sTens(1) = "ten"
        sTens(2) = "twenty"
        sTens(3) = "thirty"
        sTens(4) = "forty"
        sTens(5) = "fifty"
        sTens(6) = "sixty"
        sTens(7) = "seventy"
        sTens(8) = "eighty"
        sTens(9) = "ninety"
        sThousands(0) = ""
        sThousands(1) = "thousand"   'US numbering
        sThousands(2) = "million"
        sThousands(3) = "billion"
        sThousands(4) = "trillion"
    End If
    '
    ' Setup Error Handler
    '
    On Error GoTo vbErrorHandler
    '
    ' Get fractional part of value (if any)
    '
    sBuffer = "and " & Format$((dblVal - Int(dblVal)) * 100, "00") & "/100"
    '
    ' Convert main part to string
    '
    sValue = CStr(Int(dblVal))
    
    bAllZeros = True
    
    For i = Len(sValue) To 1 Step -1
        iChar = Val(Mid$(sValue, i, 1))
        iCol = (Len(sValue) - i) + 1
        '
        'Action depends on 1's, 10's or 100's column
        '
        Select Case (iCol Mod 3)
            Case 1  '1's position
                bShowsThousands = True
                If i = 1 Then
                    sTemp = sOnes(iChar) & " "
                ElseIf Mid$(sValue, i - 1, 1) = "1" Then
                    sTemp = sTeens(iChar) & " "
                    i = i - 1
                ElseIf iChar > 0 Then
                    sTemp = sOnes(iChar) & " "
                Else
                    bShowsThousands = False
                    If Mid$(sValue, i - 1, 1) <> "0" Then
                        bShowsThousands = True
                    ElseIf i > 2 Then
                        If Mid$(sValue, i - 2, 1) <> "0" Then
                            bShowsThousands = True
                        End If
                    End If
                    sTemp = ""
                End If
                If bShowsThousands Then
                    If iCol > 1 Then
                        sTemp = sTemp & sThousands(iCol  3)
                        If bAllZeros Then
                            sTemp = sTemp & " "
                        Else
                            sTemp = sTemp & ", "
                        End If
                    End If
                    bAllZeros = False
                End If
                sBuffer = sTemp & sBuffer
            Case 2
                If iChar > 0 Then
                    If Mid$(sValue, i + 1, 1) <> "0" Then
                        sBuffer = sTens(iChar) & "-" & sBuffer
                    Else
                        sBuffer = sTens(iChar) & " " & sBuffer
                    End If
                End If
            Case 0
                If iChar > 0 Then
                    sBuffer = sOnes(iChar) & " hundred " & sBuffer
                End If
        End Select
    Next i

    sBuffer = UCase$(Left$(sBuffer, 1)) & Mid$(sBuffer, 2)

EndNumToText:
    NumToText = sBuffer
    Exit Function

vbErrorHandler:
    sBuffer = "#Error#"
    Resume EndNumToText
End Function
;