' 本模块生成汉字大写的金额.如果只要数字,稍做修改即可' 名称: CCh
'        得到一位数字 N1 的汉字大写
'        0 返回 ""
Private 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 '10000If 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 IfIf 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 IfIf 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 IfIf 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 Ifs3 = ""
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 IfIf 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 IfIf 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 IfChMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元" & s1)End Function

解决方案 »

  1.   

    代码:
    http://www.applevb.com/sourcecode/cmoney.zip
      

  2.   

    TechnoFantasy(www.applevb.com) 
    你的程序我看了,按国家发布的标准,银行的做法,除了到“ 分 ”,其它都要在后面加“整”字。
      

  3.   

    Public Function ChangNum(StrEng As String) As String
           If Not IsNumeric(StrEng) Or StrEng Like "*.*" Or StrEng Like "*-*" Then
                If Trim(StrEng) <> "" Then MsgBox "无效的数字"
                ChangNum = "": Exit Function
           End If
           Dim intLen As Integer, intCounter As Integer
           Dim strCh As String, strTempCh As String
           Dim strSeqCh1 As String, strSeqCh2 As String
           Dim strEng2Ch As String
           strEng2Ch = "零壹贰叁肆伍陆柒捌玖"
           strSeqCh1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
           strSeqCh2 = " 万亿兆"
           StrEng = CStr(CDec(StrEng))
           intLen = Len(StrEng)
           For intCounter = 1 To intLen
                strTempCh = Mid(strEng2Ch, Val(Mid(StrEng, intCounter, 1)) + 1, 1)
                If strTempCh = "零" And intLen <> 1 Then
                     If Mid(StrEng, intCounter + 1, 1) = "0" Or (intLen - intCounter + 1) Mod 4 = 1 Then
                          strTempCh = ""
                     End If
                Else
                     strTempCh = strTempCh & Trim(Mid(strSeqCh1, intLen - intCounter + 1, 1))
                End If
                If (intLen - intCounter + 1) Mod 4 = 1 Then
                     strTempCh = strTempCh & Mid(strSeqCh2, (intLen - intCounter + 1) \ 4 + 1, 1)
                     If intCounter > 3 Then
                          If Mid(StrEng, intCounter - 3, 4) = "0000" Then strTempCh = Left(strTempCh, Len(strTempCh) - 1)
                    End If
                End If
                strCh = strCh & Trim(strTempCh)
           Next
           ChangNum = strCh
      End Function