'功能模块:数字转英文(货币)大写 'Public Function NumberToString(Number As Double) As String '调用形式:debug.print NumberToString(1234.32) '说明:最大支持12位数字,小数点后精确两位 '程序:杨鑫光(Volitation) Dim StrNO(19) As String Dim Unit(8) As String Dim StrTens(9) As String
Public Function NumberToString(Number As Double) As String Dim Str As String, BeforePoint As String, AfterPoint As String, tmpStr As String Dim Point As Integer Dim nBit As Integer Dim CurString As String Call Init '//开始处理 Str = CStr(Round(Number, 2)) ' Str = Number If InStr(1, Str, ".") = 0 Then BeforePoint = Str AfterPoint = "" Else BeforePoint = Left(Str, InStr(1, Str, ".") - 1) AfterPoint = Right(Str, Len(Str) - InStr(1, Str, ".")) End If If Len(BeforePoint) > 12 Then NumberToString = "Too Big." Exit Function End If Str = "" Do While Len(BeforePoint) > 0 nNumLen = Len(BeforePoint) If nNumLen Mod 3 = 0 Then CurString = Left(BeforePoint, 3) BeforePoint = Right(BeforePoint, nNumLen - 3) Else CurString = Left(BeforePoint, (nNumLen Mod 3)) BeforePoint = Right(BeforePoint, nNumLen - (nNumLen Mod 3)) End If nBit = Len(BeforePoint) / 3 tmpStr = DecodeHundred(CurString) If (BeforePoint = String(Len(BeforePoint), "0") Or nBit = 0) And Len(CurString) = 3 Then If CInt(Left(CurString, 1)) <> 0 And CInt(Right(CurString, 2)) <> 0 Then tmpStr = Left(tmpStr, InStr(1, tmpStr, Unit(4)) + Len(Unit(4))) & Unit(8) & " " & Right(tmpStr, Len(tmpStr) - (InStr(1, tmpStr, Unit(4)) + Len(Unit(4)))) Else 'If CInt(Left(CurString, 1)) <> 0 And CInt(Right(CurString, 2)) = 0 Then tmpStr = Unit(8) & " " & tmpStr End If End If If nBit = 0 Then Str = Trim(Str & " " & tmpStr) Else Str = Trim(Str & " " & tmpStr & " " & Unit(nBit)) End If If Left(Str, 3) = Unit(8) Then Str = Trim(Right(Str, Len(Str) - 3)) If BeforePoint = String(Len(BeforePoint), "0") Then Exit Do 'Debug.Print Str Loop BeforePoint = Str If Len(AfterPoint) > 0 Then AfterPoint = Unit(6) & " " & DecodeHundred(AfterPoint) & " " & Unit(7) Else AfterPoint = Unit(5) End If NumberToString = BeforePoint & " " & AfterPoint End Function Private Function DecodeHundred(HundredString As String) As String Dim tmp As Integer If Len(HundredString) > 0 And Len(HundredString) <= 3 Then Select Case Len(HundredString) Case 1 tmp = CInt(HundredString) If tmp <> 0 Then DecodeHundred = StrNO(tmp) Case 2 tmp = CInt(HundredString) If tmp <> 0 Then If (tmp < 20) Then DecodeHundred = StrNO(tmp) Else If CInt(Right(HundredString, 1)) = 0 Then DecodeHundred = StrTens(Int(tmp / 10)) Else DecodeHundred = StrTens(Int(tmp / 10)) & "-" & StrNO(CInt(Right(HundredString, 1))) End If End If End If Case 3 If CInt(Left(HundredString, 1)) <> 0 Then DecodeHundred = StrNO(CInt(Left(HundredString, 1))) & " " & Unit(4) & " " & DecodeHundred(Right(HundredString, 2)) Else DecodeHundred = DecodeHundred(Right(HundredString, 2)) End If Case Else End Select End If End Function Private Sub Init() If StrNO(1) <> "One" Then StrNO(1) = "One" StrNO(2) = "Two" StrNO(3) = "Three" StrNO(4) = "Four" StrNO(5) = "Five" StrNO(6) = "Six" StrNO(7) = "Seven" StrNO(8) = "Eight" StrNO(9) = "Nine" StrNO(10) = "Ten" StrNO(11) = "Eleven" StrNO(12) = "Twelve" StrNO(13) = "Thirteen" StrNO(14) = "Fourteen" StrNO(15) = "Fifteen" StrNO(16) = "Sixteen" StrNO(17) = "Seventeen" StrNO(18) = "Eighteen" StrNO(19) = "Nineteen" StrTens(1) = "Ten" StrTens(2) = "Twenty" StrTens(3) = "Thirty" StrTens(4) = "Forty" StrTens(5) = "Fifty" StrTens(6) = "Sixty" StrTens(7) = "Seventy" StrTens(8) = "Eighty" StrTens(9) = "Ninety" Unit(1) = "Thousand" '第一个三位 Unit(2) = "Million" '第二个三位 Unit(3) = "Billion" '第三个三位 Unit(4) = "Hundred" Unit(5) = "Only" Unit(6) = "Point" Unit(7) = "Cent"'不是货币的话,把此值赋空 Unit(8) = "And" End If End Sub

|