mCn=Inputbox ("请输入小写数字:","提示信息...","0.00")
If IsNumeric(mCn) And mCn<>"" then
  Cn=MoneyCn(Abs(Trim(mCn)))
  MsgBox Abs(Trim(mCn))&Chr(10)&Cn, 64, "转换结果..."
Else
  MsgBox "不是合理的人民币数字!", 64, "错误信息..."
End If

Function MoneyCn(Num)
  if Instr(1,""&Num,".")=0 then
    Num=Num&".00"
  end if
  pp=Instr(1,""&Num,".")-1
  ll=len(Num)
  For i=1 to ll
    ss=Mid(Num,i,1)
    Select case ss
      case "."
 Result=Result&"元"
      case "0"
 Result=Result&"零"
      case "1"
 Result=Result&"壹"
      case "2"
 Result=Result&"贰"
      case "3"
 Result=Result&"叁"
      case "4"
 Result=Result&"肆"
      case "5"
 Result=Result&"伍"
      case "6"
 Result=Result&"陆"
      case "7"
 Result=Result&"柒"
      case "8"
 Result=Result&"捌"
      case "9"
 Result=Result&"玖"
    End Select
    mm=pp-i
    Select case mm
      case -5
 Result=Result&"毫"
      case -4
 Result=Result&"厘"
      case -3
 Result=Result&"分"
      case -2
 Result=Result&"角"
      case 1
 Result=Result&"拾"
      case 2
 Result=Result&"佰"
      case 3
 Result=Result&"仟"
      case 4
 Result=Result&"万"
      case 5
 Result=Result&"拾"
      case 6
 Result=Result&"佰"
      case 7
 Result=Result&"仟"
      case 8
 Result=Result&"亿"
      case 9
 Result=Result&"拾"
      case 10
 Result=Result&"佰"
      case 11
 Result=Result&"仟"       
    End Select
  Next
  Result=Replace(Result, "零仟", "零")
  Result=Replace(Result, "零佰", "零")
  Result=Replace(Result, "零拾", "零") 
  Result=Replace(Result, "零零", "零")
  Result=Replace(Result, "零零", "零")
  Result=Replace(Result, "零零", "零")
  Result=Replace(Result, "零元", "元")
  Result=Replace(Result, "零角零分", "整")
  MoneyCn=Result
End Function
复制代码