|
看了网上的一些类似自定义函数,比较长,就进行了重写
说明,只支持整数,另外如有错误请提出来。
Option Compare Database
Option Explicit
Function SpellNumber(Number As Long) As String
Dim strPlace(4) As String
Dim strComma As String, intComma As Integer, i As Integer
strPlace(1) = " Thousand "
strPlace(2) = " Million "
strPlace(3) = " Billion "
strPlace(4) = " Trilion "
If Number = 0 Then SpellNumber = "No Amount ": Exit Function
For i = 0 To (Len(Str(Number)) - 2) \ 3
intComma = Number \ 10 ^ (i * 3) Mod 1000
Select Case intComma
Case Is > 99
strComma = GetDigit(intComma \ 100 Mod 10) & " Hundred And " & GetTens(intComma Mod 100)
Case Is > 9
strComma = "And " & GetTens(intComma Mod 100)
Case Else
strComma = "And " & GetDigit(intComma Mod 10)
End Select
SpellNumber = strComma & strPlace(i Mod 5) & SpellNumber
Next
If Left(SpellNumber, 3) = "And" Then SpellNumber = Right(SpellNumber, Len(SpellNumber) - 4)
End Function
Function GetTens(intTens As Integer) As String
Select Case intTens
Case Is > 19
Select Case intTens \ 10
Case 2: GetTens = "Twenty "
Case 3: GetTens = "Thirty "
Case 4: GetTens = "Forty "
Case 5: GetTens = "Fifty "
Case 6: GetTens = "Sixty "
Case 7: GetTens = "Seventy "
Case 8: GetTens = "Eighty "
Case 9: GetTens = "Ninety "
End Select
If intTens Mod 10 <> 0 Then GetTens = GetTens & GetDigit(intTens Mod 10)
Case Is > 9
Select Case intTens
Case 10: GetTens = "Ten"
Case 11: GetTens = "Eleven"
Case 12: GetTens = "Twelve"
Case 13: GetTens = "Thirteen"
Case 14: GetTens = "Fourteen"
Case 15: GetTens = "Fifteen"
Case 16: GetTens = "Sixteen"
Case 17: GetTens = "Seventeen"
Case 18: GetTens = "Eighteen"
Case 19: GetTens = "Nineteen"
End Select
Case Else
GetTens = (GetDigit(intTens))
End Select
End Function
Function GetDigit(Digit As Integer) As String
Select Case Digit
Case 1: GetDigit = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
End Select
End Function
|
|