数字转英文(货币)大写(vb)

' 功能模块：数字转英文(货币)大写
' 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

转载于:https://www.cnblogs.com/Athrun/archive/2007/06/21/792038.html