数字货币转换为大写格式

时　间:2009-10-28 09:14:38
作　者:UMVPS整理   ID：1445  城市：上海
摘　要:数字货币转换为大写格式
正　文:

数字货币转换为大写格式
以下为数字货币转换为大写格式程序, 首先建一个模块, 将以下程序复制进去并保存. (注: 最高位数为千万位)
调用方式为:
dollars = convertNum(inputValue)
  ^                        ^
须显示                  填写小
大写的                  写的控
控件                    件名

-------------------------------------------
Function GetChoice1(ByVal ind As Integer)
GetChoice1 = Choose(ind + 1, "零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
End Function
Function GetChoice2(ByVal ind As Integer) '注意"byval",按值传递
Dim tempInt As Integer
ind = ind - 1
tempInt = ind \ 4 '取商
ind = ind Mod 4 '取余
GetChoice2 = IIf(ind > 0, Choose(ind, "拾", "佰", "仟", "万"), Choose(IIf(tempInt > 2, 1, tempInt), "万", "亿"))
End Function
'--------------------------------------------
'主函数convertNum
Function ConvertNum(Baval Num As Variant) As String
Dim i As Integer, j As Integer
Dim tempInt As Integer
Dim tempStr, ResultStr As String
tempStr = CStr(Num) '转换成字符型
j = Len(tempStr) '取得长度
For i = 1 To j '对每个数字进行大写转换
tempInt = CInt(Mid(tempStr, j - i + 1, 1)) '
ResultStr = GetChoice1(tempInt) & GetChoice2(i) & ResultStr
Next i
ConvertNum = ResultStr

以下为数字货币转换为大写格式程序, 首先建一个模块, 将以下程序复制进去并保存. (注: 最高位数为千万位)
调用方式为:
dollars = chMoney(Val(inputValue))
  ^                        ^
须显示                  填写小
大写的                  写的控
控件                    件名

' 名称： CCh
'        得到一位数字 N1 的汉字大写
'        0 返回 ""
Public Function CCh(N1) As String
Select Case N1
  Case 0
    CCh = "零"
  Case 1
    CCh = "壹"
  Case 2
    CCh = "贰"
  Case 3
    CCh = "叁"
  Case 4
    CCh = "肆"
  Case 5
    CCh = "伍"
  Case 6
    CCh = "陆"
  Case 7
    CCh = "柒"
  Case 8
    CCh = "捌"
  Case 9
    CCh = "玖"
End Select
End Function

'名称： ChMoney
'       得到数字 N1 的汉字大写。最大为 千万位。 O 返回
Public Function chMoney(N1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn '小数位置
Dim s1 As String '临时STRING 小数部分
Dim s2 As String '1000 以内
Dim s3 As String '10000
Dim st1, t1

If N1 = 0 Then
  chMoney = " "
  Exit Function
End If
If N1 < 0 Then
  chMoney = "负" + chMoney(Abs(N1))
  Exit Function
End If
tMoney = Trim(Str(N1))
tn = InStr(tMoney, ".")  '小数位置
s1 = ""

If tn <> 0 Then
  st1 = Right(tMoney, Len(tMoney) - tn)
  If st1 <> "" Then
    t1 = Left(st1, 1)
    st1 = Right(st1, Len(st1) - 1)
    If t1 <> "0" Then
      s1 = s1 + CCh(Val(t1)) + "角"
    End If
    If st1 <> "" Then
     t1 = Left(st1, 1)
     s1 = s1 + CCh(Val(t1)) + "分"
    End If
  End If
  st1 = Left(tMoney, tn - 1)
Else
  st1 = tMoney
End If

s2 = ""
If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  s2 = CCh(Val(t1)) + s2
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
    s2 = CCh(Val(t1)) + "拾" + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
    s2 = CCh(Val(t1)) + "佰" + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
  s2 = CCh(Val(t1)) + "仟" + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

s3 = ""
If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  s3 = CCh(Val(t1)) + s3
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + "拾" + s3
  Else
    If Left(s3, 1) <> "零" Then s3 = "零" + s3
  End If
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + "佰" + s3
  Else
   If Left(s3, 1) <> "零" Then s3 = "零" + s3
  End If
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + "仟" + s3
  End If
End If
If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1)
If Len(s3) > 0 Then
  If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
  s3 = s3 & "万"
End If

chMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元" & s1)

End Function
如何加入换行符
C="A" + vbNewLine + "B"
[联系电话] = "1111" + Chr(13) + Chr(10) + "2222"
给一绑定文本框赋值，可以成功的看到换行效果：
1111
2222