Code to convert a Number to a spelled out number

[D]

Does anyone have a VBA code that converts numbers to Spelled out numbers?
Example 100 to One Hundred. I need it for a check writing program and I
don't feel like reinventing the wheel.

Thanks

[Trevor Best]

On Mon, 16 Feb 2004 12:19:57 -0500 in comp.databases.ms-access, "D"
<D@D> wrote:

Does anyone have a VBA code that converts numbers to Spelled out numbers?
Example 100 to One Hundred. I need it for a check writing program and I
don't feel like reinventing the wheel.

You mean like 10^100 = Google?

http://tinyurl.com/32cah

--
A)bort, R)etry, I)nfluence with large hammer.

[Jan Jørgensen]

"D" <D@D> skrev i en meddelelse news:10*************@corp.supernews.com...

Does anyone have a VBA code that converts numbers to Spelled out numbers?
Example 100 to One Hundred. I need it for a check writing program and I
don't feel like reinventing the wheel.

Thanks

I have some code I've made.
It's in a mix of danish/english .... hope you will find your way ....
otherwise feel free to send me aprivate E-mail to ask.

I made it in Excel.
But most of it should work in Access.

You type in e.g. 100,25
The printed result is :
EtHundrede 25/100

Note :
Million is equal to billion in english :-)

Here is the code :

Public msTalOrd

Private Function TalTilBogstaver(ByVal Tal As Double) As String
TalTilBogstaver = _
Bogstavering(Tal, 1000000, "Million", "er") & _
Bogstavering(Tal, 1000, "Tusinde", "") & _
Bogstavering(Tal, 1, "", "") & _
" " & Format(FormatNumber(100 * (Tal - Int(Tal)), 0), "00") & "/100"
End Function

Private Function Bogstavering(ByVal Tal As Double, ByVal Enhed As Long,
ByVal Navn As String, ByVal Flertalsendelse As String) As String
Dim sTalStreng As String
Dim lIalt As Long
Dim lHundreder As Long
Dim lEnereOgTiere As Long
lIalt = (Int(Tal) \ Enhed) Mod 1000
lHundreder = lIalt \ 100 Mod 10
lEnereOgTiere = lIalt Mod 100
If lHundreder > 0 Then
sTalStreng = Bogstavering(lHundreder, 1, "Hundrede", "")
Else
sTalStreng = ""
End If
Select Case lEnereOgTiere
Case 1 To 19
sTalStreng = sTalStreng & msTalOrd(lEnereOgTiere)
Case 20 To 99
sTalStreng = sTalStreng & msTalOrd(lEnereOgTiere \ 10) & "ti" &
msTalOrd(lEnereOgTiere Mod 10)
End Select
If lIalt = 0 Then
Bogstavering = ""
ElseIf lIalt = 1 Then
Bogstavering = sTalStreng & Navn
ElseIf lIalt > 1 Then
Bogstavering = sTalStreng & Navn & Flertalsendelse
End If
End Function

Sub Konverter_Til_Talord()
msTalOrd = Array("", "Et", "To", "Tre", "Fire", "Fem", "Seks", "Syv", _
"Otte", "Ni", "Ti", "Elleve", "Tolv", "Tretten", "Fjorten", _
"Femten", "Seksten", "Sytten", "Atten", "Nitten")

' Take the number from celle E4
Worksheets("Check_Indtastning").Range("F1").Activa te
valgt_Tal = ActiveCell.Value

' Konverter det
ud_tal = TalTilBogstaver(valgt_Tal)

' Write it Worksheets("Check_Indtastning").Range("B3").Activa te
ActiveCell.Value = ud_tal

End Sub

[leach613]

"Jan Jørgensen" <xxjjj1@pcdk (fjern xx)> wrote in message news:<40***********************@dread15.news.tele. dk>...

"D" <D@D> skrev i en meddelelse news:10*************@corp.supernews.com...

Does anyone have a VBA code that converts numbers to Spelled out numbers?
Example 100 to One Hundred. I need it for a check writing program and I
don't feel like reinventing the wheel.

Thanks

Use this, it works great. I use it for my Payroll and Accounts payable program.

'************ Code Start **********
'This code was originally written by Joe Foster.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Joe Foster
'
' Convert a currency value into an (American) English string
Function English(ByVal N As Currency) As String
Const Thousand = 1000@
Const Million = Thousand * Thousand
Const Billion = Thousand * Million
Const Trillion = Thousand * Billion

If (N = 0@) Then English = "zero": Exit Function

Dim Buf As String: If (N < 0@) Then Buf = "negative " Else Buf = ""
Dim Frac As Currency: Frac = Abs(N - Fix(N))
If (N < 0@ Or Frac <> 0@) Then N = Abs(Fix(N))
Dim AtLeastOne As Integer: AtLeastOne = N >= 1

If (N >= Trillion) Then
Debug.Print N
Buf = Buf & EnglishDigitGroup(Int(N / Trillion)) & " Trillion"
N = N - Int(N / Trillion) * Trillion ' Mod overflows
If (N >= 1@) Then Buf = Buf & " "
End If

If (N >= Billion) Then
Debug.Print N
Buf = Buf & EnglishDigitGroup(Int(N / Billion)) & " Billion"
N = N - Int(N / Billion) * Billion ' Mod still overflows
If (N >= 1@) Then Buf = Buf & " "
End If

If (N >= Million) Then
Debug.Print N
Buf = Buf & EnglishDigitGroup(N \ Million) & " Million"
N = N Mod Million
If (N >= 1@) Then Buf = Buf & " "
End If

If (N >= Thousand) Then
Debug.Print N
Buf = Buf & EnglishDigitGroup(N \ Thousand) & " Thousand"
N = N Mod Thousand
If (N >= 1@) Then Buf = Buf & " "
End If

If (N >= 1@) Then
Debug.Print N
Buf = Buf & EnglishDigitGroup(N)
End If

If (Frac = 0@) Then
'Buf = Buf & " Exactly"
Buf = Buf & " and 00/100"
ElseIf (Int(Frac * 100@) = Frac * 100@) Then
If AtLeastOne Then Buf = Buf & " and "
Buf = Buf & Format$(Frac * 100@, "00") & "/100"
Else
If AtLeastOne Then Buf = Buf & " and "
Buf = Buf & Format$(Frac * 10000@, "0000") & "/10000"
End If

English = Buf
End Function

' Support function to be used only by English()
Private Function EnglishDigitGroup(ByVal N As Integer) As String
Const Hundred = " Hundred"
Const One = "One"
Const Two = "Two"
Const Three = "Three"
Const Four = "Four"
Const Five = "Five"
Const Six = "Six"
Const Seven = "Seven"
Const Eight = "Eight"
Const Nine = "Nine"
Dim Buf As String: Buf = ""
Dim Flag As Integer: Flag = False

'Do hundreds
Select Case (N \ 100)
Case 0: Buf = "": Flag = False
Case 1: Buf = One & Hundred: Flag = True
Case 2: Buf = Two & Hundred: Flag = True
Case 3: Buf = Three & Hundred: Flag = True
Case 4: Buf = Four & Hundred: Flag = True
Case 5: Buf = Five & Hundred: Flag = True
Case 6: Buf = Six & Hundred: Flag = True
Case 7: Buf = Seven & Hundred: Flag = True
Case 8: Buf = Eight & Hundred: Flag = True
Case 9: Buf = Nine & Hundred: Flag = True
End Select

If (Flag <> False) Then N = N Mod 100
If (N > 0) Then
If (Flag <> False) Then Buf = Buf & " "
Else
EnglishDigitGroup = Buf
Exit Function
End If

'Do tens (except teens)
Select Case (N \ 10)
Case 0, 1: Flag = False
Case 2: Buf = Buf & "Twenty": Flag = True
Case 3: Buf = Buf & "Thirty": Flag = True
Case 4: Buf = Buf & "Forty": Flag = True
Case 5: Buf = Buf & "Fifty": Flag = True
Case 6: Buf = Buf & "Sixty": Flag = True
Case 7: Buf = Buf & "Seventy": Flag = True
Case 8: Buf = Buf & "Eighty": Flag = True
Case 9: Buf = Buf & "Ninety": Flag = True
End Select

If (Flag <> False) Then N = N Mod 10
If (N > 0) Then
If (Flag <> False) Then Buf = Buf & "-"
Else
EnglishDigitGroup = Buf
Exit Function
End If

'Do ones and teens
Select Case (N)
Case 0: ' do nothing
Case 1: Buf = Buf & One
Case 2: Buf = Buf & Two
Case 3: Buf = Buf & Three
Case 4: Buf = Buf & Four
Case 5: Buf = Buf & Five
Case 6: Buf = Buf & Six
Case 7: Buf = Buf & Seven
Case 8: Buf = Buf & Eight
Case 9: Buf = Buf & Nine
Case 10: Buf = Buf & "Ten"
Case 11: Buf = Buf & "Eleven"
Case 12: Buf = Buf & "Twelve"
Case 13: Buf = Buf & "Thirteen"
Case 14: Buf = Buf & "Fourteen"
Case 15: Buf = Buf & "Fifteen"
Case 16: Buf = Buf & "Sixteen"
Case 17: Buf = Buf & "Seventeen"
Case 18: Buf = Buf & "Eighteen"
Case 19: Buf = Buf & "Nineteen"
End Select

EnglishDigitGroup = Buf
End Function
'************ Code End **********