- '******************货币金额大写转换库 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
货币金额大写转换库(VB) Money2String.dll
最新推荐文章于 2021-07-27 19:29:40 发布