Here is a module that is close to what you want. With some modification, you
could make it show date and time values as well.
As Dale pointed out, be sure you are getting the correct units.
Option Compare Database
Option Explicit
Option Base 0
'Author: © Copyright 2001 Pacific Database Pty Limited
' Graham R Seach (e-mail address removed)
' Phone: +61 2 9872 9594 Fax: +61 2 9872 9593
'
' You may freely use and distribute this code
' with any applications you may develop, on the
' condition that the copyright notice remains
' unchanged, and intact as part of the code. You
' may not sell or publish this code in any form
' without the express written permission of the
' copyright holder.
'
'Description: This function converts numbers to
' their textual representation, including real, verbatim
' currency, miles and Roman.
'
'Inputs: dblNum: The number to be converted.
' intType: is the enum value representing the
' number type to be converted to.
' intCapType: is the enum value representing the
' output capitalisation required.
'
'Outputs: The number's textual representation.
Public Enum ConvType
ConvTypeReal = 1
ConvTypeVerbatim = 2
ConvTypeCurrency = 3
ConvTypeKm = 4
ConvTypeMi = 5
ConvTypeRoman = 6
End Enum
Public Enum CapType
CapUpperCase = 1
CapLowerCase = 2
CapProperCase = 3
CapProperCase_MinorLC = 4
End Enum
Public Function Num2Text(dblNum As Double, intType As ConvType, _
Optional intCapType As CapType = 1) As String
Dim strNum As String
Dim strFrac As String
Dim strTemp As String
Dim strReturn As String
Dim iCtr As Integer
Dim iPart As Integer
iPart = 1
strFrac = ""
strNum = CStr(dblNum)
'Check for fractional part
iCtr = InStr(1, strNum, ".")
If iCtr <> 0 Then
If intType = 6 Then
'If converting to Roman Numerals, can't have fractions
Num2Text = CStr(dblNum)
Exit Function
End If
If (intType = ConvTypeCurrency) Then
If (Len(strNum) - iCtr) = 1 Then strNum = strNum & "0"
'strFrac = " " & ConvertReal(CDbl(Right(strNum, Len(strNum) -
iCtr)))
strFrac = ConvertReal(CDbl(Right(strNum, Len(strNum) - iCtr)))
Else
strFrac = ConvertVerbatim(CDbl(Right(strNum, Len(strNum) - iCtr)))
End If
strNum = Left(strNum, iCtr - 1)
End If
Select Case intType
Case 1, 3, 4, 5 '*** Convert into real numbers (1) or currency (3) ***
'Pad strNum to blocks of 3
Do While (Len(strNum) / 3) - Int(Len(strNum) / 3) <> 0
strNum = "0" & strNum
Loop
For iCtr = Len(strNum) - 2 To 1 Step -3
strTemp = ConvertReal(Mid(strNum, iCtr, 3))
strTemp = strTemp & AddNouns(strTemp, iPart, _
(intType = ConvTypeCurrency) And (iPart = 1))
strReturn = strTemp & strReturn
iPart = iPart + 1
Next iCtr
Case 2 '*** Convert the individual numbers verbatim ***
strReturn = ConvertVerbatim(CDbl(strNum))
Case 6 '*** Convert to Roman Numerals ***
Num2Text = Num2Roman(CLng(dblNum))
GoTo SetCase
End Select
Select Case intType
Case ConvTypeCurrency
If (strReturn <> "") Then strReturn = strReturn & " dollars "
If (strFrac <> "") Then strFrac = strFrac & " cents"
Case ConvTypeKm
strFrac = IIf(strFrac <> "", " point " & strFrac, "") & "
kilometers"
Case ConvTypeMi
strFrac = IIf(strFrac <> "", " point " & strFrac, "") & " miles"
Case Else: If (strFrac <> "") Then strFrac = " point " & strFrac
End Select
Num2Text = Trim(strReturn & strFrac)
If Left(Trim(Num2Text), 3) = "and" Then Num2Text =
Trim(Mid(Trim(Num2Text), 4))
SetCase:
Select Case intCapType
Case CapUpperCase 'Uppercase
strTemp = UCase(Num2Text)
Case CapLowerCase 'Lowercase
strTemp = LCase(Num2Text)
Case CapProperCase 'Propercase
strTemp = StrConv(Num2Text, vbProperCase)
Case CapProperCase_MinorLC 'Propercase with Lowercase 'and'
strTemp = Replace(StrConv(Num2Text, vbProperCase), "And", "and")
End Select
'Remove any double-spaces
Num2Text = Replace(strTemp, " ", " ")
End Function
Private Function ConvertVerbatim(dblNum As Double) As String
Dim iCtr As Integer
Dim iMaxlen As Integer
Dim strNum As String
strNum = CStr(dblNum)
ConvertVerbatim = ""
iMaxlen = Len(strNum)
For iCtr = 1 To iMaxlen
Select Case Asc(Mid(strNum, iCtr, 1)) - 48
Case 0: ConvertVerbatim = ConvertVerbatim & "zero"
Case 1: ConvertVerbatim = ConvertVerbatim & "one"
Case 2: ConvertVerbatim = ConvertVerbatim & "two"
Case 3: ConvertVerbatim = ConvertVerbatim & "three"
Case 4: ConvertVerbatim = ConvertVerbatim & "four"
Case 5: ConvertVerbatim = ConvertVerbatim & "five"
Case 6: ConvertVerbatim = ConvertVerbatim & "six"
Case 7: ConvertVerbatim = ConvertVerbatim & "seven"
Case 8: ConvertVerbatim = ConvertVerbatim & "eight"
Case 9: ConvertVerbatim = ConvertVerbatim & "nine"
End Select
If iCtr < iMaxlen Then ConvertVerbatim = ConvertVerbatim & " "
Next iCtr
End Function
Private Function ConvertReal(dblNum As Double) As String
Dim strNum As String
Dim strTemp As String
Dim sN As String
strNum = CStr(dblNum)
'Pad strNum to blocks of 3
Do While (Len(strNum) / 3) - Int(Len(strNum) / 3) <> 0
strNum = "0" & strNum
Loop
If Mid(strNum, 1, 1) <> 0 Then strTemp = ConvertVerbatim(Left(strNum,
1)) & " hundred"
If Mid(strNum, 2, 1) <> 0 Or Mid(strNum, 3, 1) <> 0 Then strTemp =
strTemp & " and"
sN = Mid(strNum, 2, 2)
Select Case Asc(Mid(strNum, 2, 1)) - 48
Case 0:
Case 1
strTemp = strTemp & Switch(sN = "10", " ten", sN = "11", "
eleven", _
sN = "12", " twelve", sN = "13", " thirteen", sN = "14",
" fourteen", _
sN = "15", " fifteen", sN = "16", " sixteen", sN = "17",
" seventeen", _
sN = "18", " eighteen", sN = "19", " nineteen")
Case 2: strTemp = strTemp & " twenty"
Case 3: strTemp = strTemp & " thirty"
Case 4: strTemp = strTemp & " forty"
Case 5: strTemp = strTemp & " fifty"
Case 6: strTemp = strTemp & " sixty"
Case 7: strTemp = strTemp & " seventy"
Case 8: strTemp = strTemp & " eighty"
Case 9: strTemp = strTemp & " ninety"
End Select
If Mid(strNum, 2, 1) <> 1 Then strTemp = strTemp & " " &
ConvertVerbatim(Mid(strNum, 3, 1))
If Right(strTemp, 4) = "zero" Then strTemp = Left(strTemp, Len(strTemp)
- 5)
ConvertReal = Trim(strTemp)
End Function
Private Function Num2Roman(ByVal lngNum As Long) As String
Const Digits = "IVXLCDM"
Dim ctr As Integer, intDigit As Integer, strTmp As String
ctr = 1
strTmp = ""
Do While lngNum > 0
intDigit = lngNum Mod 10
lngNum = lngNum \ 10
Select Case intDigit
Case 1: strTmp = Mid(Digits, ctr, 1) & strTmp
Case 2: strTmp = Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) &
strTmp
Case 3: strTmp = Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) & _
Mid(Digits, ctr, 1) & strTmp
Case 4: strTmp = Mid(Digits, ctr, 2) & strTmp
Case 5: strTmp = Mid(Digits, ctr + 1, 1) & strTmp
Case 6: strTmp = Mid(Digits, ctr + 1, 1) & Mid(Digits, ctr, 1) &
strTmp
Case 7: strTmp = Mid(Digits, ctr + 1, 1) & Mid(Digits, ctr, 1) & _
Mid(Digits, ctr, 1) & strTmp
Case 8: strTmp = Mid(Digits, ctr + 1, 1) & Mid(Digits, ctr, 1) & _
Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) & strTmp
Case 9: strTmp = Mid(Digits, ctr, 1) & Mid(Digits, ctr + 2, 1) &
strTmp
End Select
ctr = ctr + 2
Loop
Num2Roman = strTmp
End Function
Private Function AddNouns(strNum As String, ByVal intPart As Integer, _
booCurrency As Boolean) As String
If Len(strNum) > 0 Then
Select Case intPart
'Case 1: If (booCurrency = True) Then AddNouns = " dollars"
Case 2: AddNouns = " thousand "
Case 3: AddNouns = " million "
Case 4: AddNouns = " billion "
Case 5: AddNouns = " trillion "
Case 6: AddNouns = " quadrillion "
Case 7: AddNouns = " quintillion "
Case 8: AddNouns = " sextillion "
Case 9: AddNouns = " septillion "
Case 10: AddNouns = " octillion"
End Select
Else
AddNouns = ""
End If
End Function
--
Dave Hargis, Microsoft Access MVP
jesseu via AccessMonster.com said:
I have a report that sums up total time as 14:20:0 I would it to read 14 days,
20 Hours, 0 Minutes can someone help. This is what I have in a text field
=Int([text34]/24) & ":" & Format(([text34]/24-Int([text34]/24))*60,"00")
Thank You
