'功能模块:数字转英文(货币)大写

'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




樣式一:

Dim StrNO(19)

Dim Unit(8)

Dim StrTens(9)

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) = "And"

Unit(7) = "Cents"'不是貨幣的話,把此值賦空

Unit(8) = ""


'*****************************************

'功能模塊:數字轉文貨幣大寫

'調用形式: NumberToString(1234.32)

'說明:最大支持12位數字,小數點後清確到兩位

'*****************************************

Function NumberToString(Number)

  Dim Str, BeforePoint, AfterPoint, tmpStr

  Dim Point

  Dim nBit

  Dim CurString


  '//開始處理

    'Str = CStr(Round(Number,2))這是之前的改為了下面的

  Str = FormatNumber(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) & " " & Unit(7) & " " & DecodeHundred(AfterPoint)

  Else

    AfterPoint = Unit(5)

  End If

  NumberToString = BeforePoint & " " & AfterPoint

End Function


Function DecodeHundred(HundredString)

  Dim tmp

  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





輸出格式如下:

200.68 

SAY TOTAL U.S. DOLLARS TWO HUNDRED AND CENTS SIXTY EIGHT ONLY 



116.85 

SAY TOTAL U.S. DOLLARS ONE HUNDRED SIXTEEN AND CENTS EIGHTY FIVE ONLY 



672.99 

SAY TOTAL U.S. DOLLARS SIX HUNDRED SEVENTY TWO AND CENTS NINETY NINE ONLY 


1573.07 

SAY TOTAL U.S. DOLLARS ONE THOUSAND FIVE HUNDRED SEVENTY THREE AND CENTS SEVEN ONLY



樣式二:

Dim StrNO(19)

Dim Unit(8)

Dim StrTens(9)

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"



'*****************************************

'功能模塊:數字轉文貨幣大寫

'調用形式: NumberToString(1234.32)

'說明:最大支持12位數字,小數點後清確到兩位

'*****************************************

Function NumberToString(Number)

  Dim Str, BeforePoint, AfterPoint, tmpStr

  Dim Point

  Dim nBit

  Dim CurString


  '//開始處理

    'Str = CStr(Round(Number,2))這是之前的改為了下面的

  Str = FormatNumber(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


Function DecodeHundred(HundredString)

  Dim tmp

  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


輸出樣式如下:

200.68

SAY TOTAL U.S. DOLLARS TWO HUNDRED POINT SIXTY-EIGHT CENT ONLY

116.85

SAY TOTAL U.S. DOLLARS ONE HUNDRED AND SIXTEEN POINT EIGHTY-FIVE CENT ONLY

672.99

SAY TOTAL U.S. DOLLARS SIX HUNDRED AND SEVENTY-TWO POINT NINETY-NINE CENT ONLY

1573.07

SAY TOTAL U.S. DOLLARS ONE THOUSAND FIVE HUNDRED AND SEVENTY-THREE POINT SEVEN CENT ONLY