VB 金额小写数字转大写

'本模块生成汉字大写的金额
'输入：数字
'输出：大写金额
Public Function Num2CharZheng(ByVal N As Double) As String
 On Error GoTo ErrorH
 If Right(Num2Char(N), 1) = "元" Or Right(Num2Char(N), 1) = "角" Then
    Num2CharZheng = Num2Char(N) + "正"
 Else
    Num2CharZheng = Num2Char(N)
 End If
 Exit Function
ErrorH:
 Num2CharZheng = "溢出"
End Function




'本模块生成汉字大写的金额
'输入：数字
'输出：大写金额
Public Function Num2Char(ByVal N As Double) As String
 On Error GoTo ErrorH
 
 If N >= 100000000 Then
  Num2Char = Num2CharLarge(Round(N, 2))
 Else
  Num2Char = Num2CharSmall(Round(N, 2))
 End If
 
 Exit Function
ErrorH:
 Num2Char = "溢出"
End Function


' 名称： CCh(Num2Char辅助函数)
'        得到一位数字 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




'名称： Num2CharSmall(Num2Char辅助函数)
'       得到数字 N1 的汉字大写
'       最大为 千万位
'       O 返回 ""
Public Function Num2CharSmall(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 As String, T1 As String




 If N1 = 0 Then
  Num2CharSmall = " "
  Exit Function
 End If
 
 If N1 < 0 Then
  Num2CharSmall = "负" + Num2CharSmall(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


 Num2CharSmall = IIf(s3 & S2 = "", S1, s3 & S2 & "元" & S1)
End Function


'金额的人民币大写(Num2Char辅助函数)
'输入：数值型金额
'输出：大写格式
Public Function Num2CharLarge(ByVal M_Num As Double) As String
 On Error Resume Next
 Num2CharLarge = "N/A"
 
 Dim ZsFlg As Boolean
 ZsFlg = IIf(M_Num < 0, False, True)
 M_Num = Abs(M_Num)
 
 Dim Nt_Decj, Nt_Decf, M_Szstr, M_Numstr, M_Lenint, M_Lendec, M_Dxstr, M_I, M_a, M_b, M_c, M_d, M_Bbak As Variant
 Dim M_Dxint(13), M_Dxdec(2), M_SZ(13) As Variant
  
 If M_Num < 1 Then                                                          '新增的小于一元的情况!
  Nt_Decj = Val(Left(Right(Format(M_Num, "0.00"), 2), 1))                   '角
  Nt_Decf = Val(Right(Format(M_Num, "0.00"), 1))                            '分
  M_Szstr = "零壹贰叁肆伍陆柒捌玖"
  
   
  If Nt_Decj = 0 Then
   Num2CharLarge = Mid(M_Szstr, Nt_Decf + 1, 1) + "分"
  Else
   
   If Nt_Decf = 0 Then
    Num2CharLarge = Mid(M_Szstr, Nt_Decj + 1, 1) + "角"
   Else
    Num2CharLarge = Mid(M_Szstr, Nt_Decj + 1, 1) + "角" + Mid(M_Szstr, Nt_Decf + 1, 1) + "分"
   End If
  End If
   
  Exit Function
 End If
  
 M_Numstr = AllTrim(Format(M_Num, "#################.00"))      ' "1225.25"
 M_Lenint = Len(Mid(M_Numstr, 1, InStr(1, M_Numstr, ".") - 1))  ' len(mid("1225.25",1,5-1))  -> len("1225") -> 4      取出整数长度
 M_Lendec = IIf(M_Num - Int(M_Num) = 0, 0, 2)                   ' iif(1225.25-1225=0,0,2)    -> 2                     取出小数长度
  
 M_Dxstr = "万仟佰拾亿仟佰拾万仟佰拾元"
 M_Szstr = "零壹贰叁肆伍陆柒捌玖"
 'M_Szstr = " 壹贰叁肆伍陆柒捌玖"
  
 For M_I = 1 To 13                                              '针对M_Dxstr   13个
  M_Dxint(M_I) = Mid(M_Dxstr, 13 - M_I + 1, 1)                  'M_dxstr的反向数组    M_dxint(1)="元",M_dxint(2)="拾",......,M_dxint(13)="万",
  M_SZ(M_I) = IIf(M_I < 11, Mid(M_Szstr, M_I, 1), "")           'M_sz的正向数组       M_sz(1)="零",M_sz(2)="壹",...M_sz(10)="玖",M_sz(11-13)=""
 Next M_I
  
 M_Dxdec(1) = "角"
 M_Dxdec(2) = "分"
 M_Dxstr = ""                                                   '清空
  
 For M_I = 1 To M_Lenint                                        'M_lenint整数部分长度 -> 4             整数部分诸位取出
  M_a = Mid(Mid(M_Numstr, 1, M_Lenint), M_I, 1)                 'mid(mid("1225.25",1,4),1,1)-> 1 -> 2 -> 2 -> 5
  M_b = M_SZ(Val(M_a) + 1)                                      '整数部分诸位转化           ->壹 ->贰 ->贰 ->伍
  M_c = M_Dxint(M_Lenint - M_I + 1)                             'M_dxint(4-1+1)             ->仟 ->佰 ->拾 ->元
   
  If "" <> M_Dxstr Then
   M_d = Mid(M_Dxstr, Len(M_Dxstr) - 1, 1)
  Else
   M_d = ""
  End If
   
  M_b = IIf(M_b = "零" And (M_d = "零" Or M_Bbak = M_b Or M_c = "元" Or M_c = "万" Or M_c = "亿"), "", M_b)
  M_c = IIf(M_a = "0" And M_c <> "元" And M_c <> "万" And M_c <> "亿", "", M_c)
   
  If (M_c = "元" Or M_c = "万" Or M_c = "亿") And M_d = "零" And M_a = "0" Then
   M_Dxstr = Mid(M_Dxstr, 1, Len(M_Dxstr) - 1)
   M_d = Mid(M_Dxstr, Len(M_Dxstr) - 1, 1)
   M_c = IIf(M_c = "元" And M_d = "万" Or M_c = "万" And M_d = "亿", "", M_c)
  End If
   
  M_Dxstr = M_Dxstr + M_b + M_c
  M_Bbak = M_b
 Next M_I
  
 For M_I = 1 To M_Lendec                                                        '小数部分
  M_a = Mid(Mid(M_Numstr, M_Lenint + 2, M_Lendec), M_I, 1)                      'mid(mid("1225.25",4+2,2),1,1) -> mid("25",1,1)-> 2 ==> 5 诸位提取小数位
  M_b = IIf(M_a = "0" And M_Dxdec(M_I) = "分", "", M_SZ(Val(M_a) + 1))
  M_Dxstr = IIf(M_a <> "0", M_Dxstr + M_b + M_Dxdec(M_I), M_Dxstr + M_b + "")
 Next M_I
  
 Num2CharLarge = IIf(M_Lendec = 0, M_Dxstr + "整", M_Dxstr)
 Num2CharLarge = IIf(ZsFlg, Num2CharLarge, "负" + Num2CharLarge)
End Function