关于转换人民币大写的程序，谁有现成的VB源代码吗？谢谢！！

Question

关于转换人民币大写的程序，谁有现成的VB源代码吗？谢谢！！

Answer 1

'*********************************************************
'* 名称：nNumber2Chinese
'* 功能：数值转换为人民币(汉字)
'* 用法：nNumber2Chinese(数值)
'*********************************************************
Public Function Num2Chi(txtJE As Double) As String
    Dim I, K As Integer
    Dim NC, nd, ka, chrNum, strZheng As String
    Dim c1, c2, c3 As String
    Dim K1 As Integer
    Dim Zheng As String
    Dim Xiao As String
    NC = Trim(Format(txtJE, "##0.00"))
    c1 = "仟佰拾万仟佰拾亿仟佰拾万仟佰拾元"
    c2 = "角分"
    c3 = "玖捌柒陆伍肆叁贰壹"
    If NC = 0 Then
        Num2Chi = "零元整"
        Exit Function
    End If
    Num2Chi = ""
    Zheng = Mid(NC, 1, (Len(NC) - 3))
    Xiao = Mid(NC, (Len(Zheng) + 2))
    If Val(Xiao) <> 0 Then
        For I = Len(Xiao) To 1 Step -1
            chrNum = Mid(Xiao, I, 1)
            If chrNum <> 0 Then
                Num2Chi = Mid(c2, I, 1) & Num2Chi
                Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
            End If
        Next I
    End If
    
    K = 0
    If Val(Zheng) <> 0 Then
        Num2Chi = "元" & Num2Chi
        For I = Len(Zheng) To 1 Step -1
            If (Len(Zheng) - I) = 4 Then
                Num2Chi = "万" & Num2Chi
            ElseIf (Len(Zheng) - I) = 8 Then
                Num2Chi = "亿" & Num2Chi
            ElseIf (Len(Zheng) - I) = 12 Then
                Num2Chi = "万" & Num2Chi
            End If
            chrNum = Mid(Zheng, I, 1)
            If chrNum <> 0 Then
                If I = Len(Zheng) Then
                    Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
                Else
                    If (Len(Zheng) - I) <> 4 And (Len(Zheng) - I) <> 8 And (Len(Zheng) - I) <> 12 Then
                        Num2Chi = Mid(c1, (Len(c1) - K), 1) & Num2Chi
                    End If
                    Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
                End If
            Else
                If Mid(Num2Chi, 1, 1) <> "元" And Mid(Num2Chi, 1, 1) <> "万" And Mid(Num2Chi, 1, 1) <> "亿" Then
                    If Mid(Num2Chi, 1, 1) <> "零" Then
                        Num2Chi = "零" & Num2Chi
                    End If
                End If
           End If
            K = K + 1
        Next I
    End If
    If Right(Trim(Num2Chi), 1) <> "分" Then
        Num2Chi = Num2Chi & "整"
    End If
End Function

Answer 2

再看看这个，其实差不多！^_^
' 本模块生成汉字大写的金额
' 名称： 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 '10000
    Dim st1 As String
    Dim t1 As String
    
    
    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
    
    If tn <> 0 Then
        ChMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元" & s1)
    Else
        ChMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元整")
    End IfEnd Function