变换数字为人民币大写的算法代码，有用的着的拿去

'-------------------------------- 
'将双精度型数值转化为大写人民币金额 
'-------------------------------- 
Public Function DblToCurr(ByVal ValNum As Double) 
Dim RetStr As String, strUnit As String, tmpStr As String 
Dim LenStr As Integer, i As Integer, j As Integer 
Dim strUnits As String, strNums As String, CurNum As Integer 
Dim PreZero As Boolean 
  
'  If ValNum < 0 Then 
'    MsgBox "金额小于零", vbInformation, "系统提示" 
'  End If 
  ValNum = Abs(ValNum) 
  If ValNum >= 1E+15 Then 
      MsgBox "金额太大，系统不能处理！", vbInformation, "系统提示" 
      RetStr = "零元" 
      GoTo ReturnResult 
  End If 
  strNums = "零壹贰叁肆伍陆柒捌玖": strUnits = "拾百千万亿" 
  ValNum = Int(ValNum * 100 + 0.5) / 100 
  tmpStr = Trim(Str(Abs(ValNum))) 
  LenStr = Len(tmpStr) 
  i = InStr(1, tmpStr, "."): If i = 0 Then i = LenStr + 1 
  RetStr = "元" 
  RetStr = RetStr & Mid(strNums, Val(Mid(tmpStr, i + 1, 1)) + 1, 1) & "角" 
  RetStr = RetStr & Mid(strNums, Val(Mid(tmpStr, i + 2, 1)) + 1, 1) & "分" 
  If ValNum < 1 Then RetStr = "零" & RetStr 
  j = 0: PreZero = False: strUnit = "" 
  Do While i > 1 
      i = i - 1 
      CurNum = Val(Mid(tmpStr, i, 1)) 
      If CurNum = 0 Then 
        If j Mod 4 = 0 Then 
            RetStr = strUnit & RetStr 
        ElseIf PreZero = False Then 
            RetStr = Mid(strNums, 1, 1) & RetStr 
        End If 
        PreZero = True 
      Else 
        RetStr = Mid(strNums, CurNum + 1, 1) & strUnit & RetStr 
        PreZero = False 
      End If 
      j = j + 1 
      If j = 4 Or j = 12 Then 
        strUnit = Mid(strUnits, 4, 1) 
        PreZero = False 

      ElseIf j = 8 Then 
        strUnit = Mid(strUnits, 5, 1) 
        PreZero = False 
      Else 
        strUnit = Mid(strUnits, j Mod 4, 1) 
      End If 
  Loop 
ReturnResult: 
  DblToCurr = RetStr 
End Function