货币金额大写转换库(VB) Money2String.dll

来源：互联网发布：linux部署多个tomcat 编辑：程序博客网时间：2024/05/20 22:39
'******************货币金额大写转换库 Money2String.dll ********************* 
' 
' 
'中文大写转换方法       String GetCnString(String MoneyString) 
'最大转化金额           999999999999999999999999.99  （24位整数位，2位小数位） 
'方法返回值             转换成功则返回非零长字串,否则返回零长字串 
' 
'英文大写转换方法       String GetEnString(String MoneyString) 
'最大转化金额           999999999999999.99   （15位整数位，2位小数位） 
'方法返回值             转换成功则返回非零长字串,否则返回零长字串 
' 
' 
'程序设计 xlFancy       Copyright (C) 2003.03.18 - 2006.12.05 
'邮箱地址 xlfancy@21cn.com 
' 
'************************************************************************** 
Option Explicit
'中文大写转换 
Public Function GetCnString(ByVal MoneyString As String) As String
Dim i As Long
Dim k As Long
Dim j As Long
Dim n As Long
Dim rmbCapital As String
Dim intString As String
Dim decString As String
Dim tmpString() As String
Dim cnNumber() As String
Dim cnUnit() As String
On Error GoTo cnstr_err:
'初始化中文数字、单位 
cnNumber = Split("零,壹,贰,叁,肆,伍,陆,柒,捌,玖", ",")
cnUnit = Split("分,角,元,拾,佰,仟,万,拾,佰,仟,亿,拾,佰,仟,兆,拾,佰,仟,京,拾,佰,仟,垓,拾,佰,仟", ",")
decString = ""
intString = MoneyString
tmpString = Split(MoneyString, ".")
If UBound(tmpString) Then
   intString = tmpString(0)
   decString = tmpString(1)
End If
intString = intString & Left(decString & "00", 2)
rmbCapital = ""
k = Len(intString) - 1
If k > 25 Then  'Len(cnUnit) - 1 
   rmbCapital = MoneyString  '超出转换范围，返回原值 
Else
   If Val(intString) = 0 Then
      rmbCapital = "零元"
   Else
      For i = 0 To k
          j = Val(Mid(intString, i + 1, 1))
          rmbCapital = rmbCapital & cnNumber(j) & cnUnit(k - i)
      Next i
   
      rmbCapital = Replace(rmbCapital, "零分", "零")
      rmbCapital = Replace(rmbCapital, "零角", "零")
      rmbCapital = Replace(rmbCapital, "零拾", "零")
      rmbCapital = Replace(rmbCapital, "零佰", "零")
      rmbCapital = Replace(rmbCapital, "零仟", "零")
      
      rmbCapital = Replace(rmbCapital, "零零零", "零")
      rmbCapital = Replace(rmbCapital, "零零", "零")
      
      rmbCapital = Replace(rmbCapital, "零元", "元")
      rmbCapital = Replace(rmbCapital, "零万", "万")
      rmbCapital = Replace(rmbCapital, "零亿", "亿")
      rmbCapital = Replace(rmbCapital, "零兆", "兆")
      rmbCapital = Replace(rmbCapital, "零京", "京")
      rmbCapital = Replace(rmbCapital, "零垓", "垓")
   
      rmbCapital = Replace(rmbCapital, "垓京兆亿万", "垓")
      rmbCapital = Replace(rmbCapital, "垓京兆亿", "垓")
      rmbCapital = Replace(rmbCapital, "京兆亿万", "京")
      rmbCapital = Replace(rmbCapital, "垓京兆", "垓")
      rmbCapital = Replace(rmbCapital, "京兆亿", "京")
      rmbCapital = Replace(rmbCapital, "兆亿万", "兆")
      rmbCapital = Replace(rmbCapital, "垓京", "垓")
      rmbCapital = Replace(rmbCapital, "垓兆", "垓")
      rmbCapital = Replace(rmbCapital, "垓亿", "垓")
      rmbCapital = Replace(rmbCapital, "垓万", "垓")
      rmbCapital = Replace(rmbCapital, "京兆", "京")
      rmbCapital = Replace(rmbCapital, "京亿", "京")
      rmbCapital = Replace(rmbCapital, "京万", "京")
      rmbCapital = Replace(rmbCapital, "兆亿", "兆")
      rmbCapital = Replace(rmbCapital, "兆万", "兆")
      rmbCapital = Replace(rmbCapital, "亿万", "亿")
   
      '无小数位时 
      If Mid(rmbCapital, Len(rmbCapital), 1) = "零" Then
         rmbCapital = Left(rmbCapital, Len(rmbCapital) - 1)
      End If
      '无整数位时 
      If Left(rmbCapital, 1) = "元" Then
         rmbCapital = Mid(rmbCapital, 2, Len(rmbCapital) - 1)
      End If
      '无角币位时 
      If Left(rmbCapital, 1) = "零" Then
         rmbCapital = Mid(rmbCapital, 2, Len(rmbCapital) - 1)
      End If
   End If
End If
cnstr_exit:
GetCnString = rmbCapital
Exit Function
cnstr_err:
rmbCapital = ""  '非数字类型错误，返回零长字串 
Resume cnstr_exit
End Function
'英文大写转换 
Public Function GetEnString(ByVal MoneyString As String) As String
Dim n As Long
Dim k As Long
Dim i1 As Long
Dim i2 As Long
Dim i3 As Long
Dim curPoint As Long
Dim strbuff1 As String
Dim strBuff2 As String
Dim strBuff3 As String
Dim engCapital As String    '保存英文大写字串 
Dim intString As String     '保存整数部分字串 
Dim decString As String     '保存小数部分字串 
Dim tmpString() As String
Dim enSmallNumber() As String
Dim enLargeNumber() As String
Dim enUnit() As String
On Error GoTo enstr_err
'初始化英文数字、单位 
enSmallNumber = Split(",ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE,TEN,ELEVEN,TWELVE,THIRTEEN,FOURTEEN,FIFTEEN,SIXTEEN,SEVENTEEN,EIGHTEEN,NINETEEN", ",")
enLargeNumber = Split("TWENTY,THIRTY,FORTY,FIFTY,SIXTY,SEVENTY,EIGHTY,NINETY", ",")
enUnit = Split(",THOUSAND,MILLION,BILLION,TRILLION", ",")
decString = ""
intString = MoneyString
tmpString = Split(MoneyString, ".")
If UBound(tmpString) Then
   intString = tmpString(0)
   decString = tmpString(1)
End If
decString = Left(decString & "00", 2)
engCapital = ""
curPoint = Len(intString)
If curPoint > 0 And curPoint < 16 Then
     '以下处理整数部分 
     k = 0
     Do While (curPoint > 0)
         strbuff1 = ""
         strBuff2 = ""
         strBuff3 = ""
         If curPoint >= 3 Then
             n = Val(Mid(intString, curPoint - 2, 3))
             If n <> 0 Then
                 i1 = Int(n / 100)              '取佰位数值 
                 i2 = Int((n - i1 * 100) / 10)  '取拾位数值 
                 i3 = n Mod 10                  '取个位数值 
                 If i1 <> 0 Then
                     strbuff1 = enSmallNumber(i1) + " HUNDRED "
                 End If
                 
                 If i2 <> 0 Then
                     If i2 = 1 Then
                         strBuff2 = enSmallNumber(i2 * 10 + i3) & " "
                     Else
                         strBuff2 = enLargeNumber(i2 - 2) & " "
                         If i3 <> 0 Then
                             strBuff3 = enSmallNumber(i3) & " "
                         End If
                     End If
                 Else
                     If i3 <> 0 Then
                         strBuff3 = enSmallNumber(i3) & " "
                     End If
                 End If
                 engCapital = strbuff1 & strBuff2 & strBuff3 & enUnit(k) & " " & engCapital
             End If
         Else
             n = Val(Left(intString, curPoint))
             If n <> 0 Then
                 i2 = Int(n / 10)   '取拾位数值 
                 i3 = n Mod 10      '取个位数值 
                 If i2 <> 0 Then
                     If i2 = 1 Then
                         strBuff2 = enSmallNumber(i2 * 10 + i3) & " "
                     Else
                         strBuff2 = enLargeNumber(i2 - 2) & " "
                         If i3 <> 0 Then
                             strBuff3 = enSmallNumber(i3) & " "
                         End If
                     End If
                 Else
                     If i3 <> 0 Then
                         strBuff3 = enSmallNumber(i3) & " "
                     End If
                 End If
                 engCapital = strBuff2 & strBuff3 & enUnit(k) & " " & engCapital
             End If
         End If
         k = k + 1
         curPoint = curPoint - 3
     Loop
     engCapital = Trim(engCapital)
     '以下处理小数部分 
     strBuff2 = ""
     strBuff3 = ""
     n = Val(decString)
     If n <> 0 Then
          i2 = Int(n / 10)   '取拾位数值 
          i3 = n Mod 10      '取个位数值 
          If i2 <> 0 Then
              If i2 = 1 Then
                  strBuff2 = enSmallNumber(i2 * 10 + i3) & " "
              Else
                  strBuff2 = enLargeNumber(i2 - 2) & " "
                  If i3 <> 0 Then
                      strBuff3 = enSmallNumber(i3) & " "
                  End If
              End If
          Else
              If i3 <> 0 Then
                  strBuff3 = enSmallNumber(i3) & " "
              End If
          End If
        
         '将小数字串追加到整数字串后 
          If Len(engCapital) > 0 Then
              engCapital = engCapital & " AND CENTS " & strBuff2 & strBuff3  '有整数部分时 
          Else
              engCapital = "CENTS " & strBuff2 & strBuff3  '只有小数部分时 
          End If
     End If
     engCapital = Trim(engCapital)
Else
     engCapital = MoneyString  '超出转换范围，返回原值 
End If
enstr_exit:
GetEnString = engCapital
Exit Function
enstr_err:
engCapital = ""  '转换错误，返回零长字串 
Resume enstr_exit
End Function