|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
<P>Function SpellNumber(ByVal MyNumber)<BR> <BR> Dim Dollars, Cents, Temp<BR> Dim DecimalPlace, Count<BR> ReDim Place(9) As String<BR> Application.Volatile True<BR> Place(2) = " Thousand "<BR> Place(3) = " Million "<BR> Place(4) = " Billion "<BR> Place(5) = " Trillion "<BR> MyNumber = Trim(Str(MyNumber))<BR> DecimalPlace = InStr(MyNumber, ".")<BR> <BR> If DecimalPlace > 0 Then<BR> Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))<BR> MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))<BR> End If<BR> Count = 1<BR> Do While MyNumber <> ""<BR> Temp = GetHundreds(Right(MyNumber, 3))<BR> If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars<BR> If Len(MyNumber) > 3 Then<BR> MyNumber = Left(MyNumber, Len(MyNumber) - 3)<BR> Else<BR> MyNumber = ""<BR> End If<BR> Count = Count + 1<BR> Loop<BR> Select Case Dollars<BR> Case ""<BR> Dollars = "No Dollars"<BR> Case "One"<BR> Dollars = "One Dollar"<BR> Case Else<BR> Dollars = Dollars & " Dollars"<BR> End Select<BR> Select Case Cents<BR> Case ""<BR> Cents = " Only"<BR> Case "One"<BR> Cents = " and One Cent"<BR> Case Else<BR> Cents = " and " & Cents & " Cents"<BR> End Select<BR> SpellNumber = Dollars & Cents</P>
<P>End Function</P>
<P>Function GetHundreds(ByVal MyNumber)<BR> <BR> Dim Result As String<BR> If Val(MyNumber) = 0 Then Exit Function<BR> MyNumber = Right("000" & MyNumber, 3)<BR> If Mid(MyNumber, 1, 1) <> "0" Then<BR> Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "<BR> End If<BR> If Mid(MyNumber, 2, 1) <> "0" Then<BR> Result = Result & GetTens(Mid(MyNumber, 2))<BR> Else<BR> Result = Result & GetDigit(Mid(MyNumber, 3))<BR> End If<BR> GetHundreds = Result<BR> <BR>End Function</P>
<P>Function GetTens(TensText)<BR> Dim Result As String<BR> Result = ""<BR> If Val(Left(TensText, 1)) = 1 Then<BR> Select Case Val(TensText)<BR> Case 10: Result = "Ten"<BR> Case 11: Result = "Eleven"<BR> Case 12: Result = "Twelve"<BR> Case 13: Result = "Thirteen"<BR> Case 14: Result = "Fourteen"<BR> Case 15: Result = "Fifteen"<BR> Case 16: Result = "Sixteen"<BR> Case 17: Result = "Seventeen"<BR> Case 18: Result = "Eighteen"<BR> Case 19: Result = "Nineteen"<BR> Case Else<BR> End Select<BR> Else<BR> Select Case Val(Left(TensText, 1))<BR> Case 2: Result = "Twenty "<BR> Case 3: Result = "Thirty "<BR> Case 4: Result = "Forty "<BR> Case 5: Result = "Fifty "<BR> Case 6: Result = "Sixty "<BR> Case 7: Result = "Seventy "<BR> Case 8: Result = "Eighty "<BR> Case 9: Result = "Ninety "<BR> Case Else<BR> End Select<BR> Result = Result & GetDigit _<BR> (Right(TensText, 1))<BR> End If<BR> GetTens = Result</P>
<P>End Function</P>
<P>Function GetDigit(Digit)<BR> <BR> Select Case Val(Digit)<BR> Case 1: GetDigit = "One"<BR> Case 2: GetDigit = "Two"<BR> Case 3: GetDigit = "Three"<BR> Case 4: GetDigit = "Four"<BR> Case 5: GetDigit = "Five"<BR> Case 6: GetDigit = "Six"<BR> Case 7: GetDigit = "Seven"<BR> Case 8: GetDigit = "Eight"<BR> Case 9: GetDigit = "Nine"<BR> Case Else: GetDigit = ""<BR> End Select</P>
<P>End Function<BR></P>
<P>拿这个试一下,也是在这里看过的,平常用的不多,没仔细研究过</P> |
|