哪位有现成的小写金额转大写程序或函数FOR VB

看我的文档
http://www.csdn.net/develop/read_article.asp?id=14036

我的不是很好，可以参考一下：数字向中文转换上Public Function ChinaNum(ByVal Num As String) As String
On Error GoTo ChinaNumErr
ChinaNum = ""Dim str_tmp_CN As String
Dim str_tmp_ZS As String
Dim str_tmp_XS As String
Dim I As LongIf VBA.Trim(Num) = "" Then
    GoTo ChinaNumErr
End IfFor I = 1 To VBA.Len(Num) Step 1
     Select Case VBA.Mid$(Num, I, 1)
         Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "0", "."
         Case Else
              GoTo ChinaNumErr
     End Select
Next IIf Num Like "*.*" Then
    If Num Like "*.*.*" Then
        GoTo ChinaNumErr
    End If
    I = VBA.InStr(1, Num, ".", vbTextCompare)
    str_tmp_ZS = VBA.Left(Num, I - 1)
    str_tmp_XS = VBA.Right(Num, VBA.Len(Num) - I)
    str_tmp_ZS = zsTOstr(str_tmp_ZS)
    str_tmp_XS = xsTOstr(str_tmp_XS)


    If str_tmp_ZS = "" Then
        str_tmp_CN = "零"
    Else
        str_tmp_CN = str_tmp_ZS
    End If    If str_tmp_XS <> "" Then
        str_tmp_CN = str_tmp_CN & "点" & str_tmp_XS
    End IfEnd If
GoTo ChinaNumOKChinaNumOK:
    If str_tmp_CN <> "" Then
        Let ChinaNum = str_tmp_CN
    Else
        GoTo ChinaNumErr
    End If
    GoTo ChinaNumExitChinaNumErr:
    Err.Clear
    ChinaNum = ""
    GoTo ChinaNumExit

ChinaNumExit:
    'clear all money
    str_tmp_CN = ""
    str_tmp_ZS = ""
    str_tmp_XS = ""
    I = 0
    Exit Function

End Function
       以上代码来自： SourceCode Explorer(源代码数据库)
           复制时间： 2002-06-17 20:10:59
           当前版本： 1.0.707
               作者： Shawls
           个人主页： Http://Shawls.Yeah.Net
             E-Mail： [email protected]
                 QQ： 9181729
数字向中文转换下Private Function zsTOstr(ByVal str_ZS As String) As String
On Error GoTo zsTOstrErr
     If Not IsNumeric(str_ZS) Or str_ZS Like "*.*" Or str_ZS Like "*-*" Then
          If Trim(str_ZS) <> "" Then
              GoTo zsTOstrErr
          End If
     End If

     If VBA.Len(str_ZS) > 16 Then
         Let str_ZS = VBA.Left(str_ZS, 16)
     End If

     Dim intLen As Integer, intCounter As Integer
     Dim strCh As String, strTempCh As String
     Dim strSeqCh1 As String, strSeqCh2 As String
     Dim str_ZS2Ch As String
     str_ZS2Ch = "零壹贰叁肆伍陆柒捌玖"
     strSeqCh1 = " 拾佰仟拾佰仟拾佰仟拾佰仟"
     strSeqCh2 = " 万亿兆"
     str_ZS = CStr(CDec(str_ZS))
     intLen = Len(str_ZS)
     For intCounter = 1 To intLen
          strTempCh = Mid(str_ZS2Ch, Val(Mid(str_ZS, intCounter, 1)) + 1, 1)
          If strTempCh = "零" And intLen <> 1 Then
               If Mid(str_ZS, 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(str_ZS, intCounter - 3, 4) = "0000" Then strTempCh = Left(strTempCh, Len(strTempCh) - 1)
              End If
          End If
          strCh = strCh & Trim(strTempCh)
     Next
     GoTo zsTOstrOKzsTOstrOK:
    Let zsTOstr = strCh
    GoTo zsTOstrExitzsTOstrErr:
    Err.Clear
    zsTOstr = ""
    GoTo zsTOstrExitzsTOstrExit:
    strCh = ""
    intLen = 0
    intCounter = 0
    strTempCh = ""
    strSeqCh1 = ""
    strSeqCh2 = ""
    str_ZS2Ch = ""
    Exit FunctionEnd FunctionPrivate Function xsTOstr(ByVal str_XS As String) As String
On Error GoTo xsTOstrErr
     If Not IsNumeric(str_XS) Or str_XS Like "*.*" Or str_XS Like "*-*" Then
          If Trim(str_XS) <> "" Then
              GoTo xsTOstrErr
          End If
     End If

     If VBA.Len(str_XS) > 20 Then
         GoTo xsTOstrErr
     End If

     Dim str_TH As String
     str_TH = "零壹贰叁肆伍陆柒捌玖"

     Dim I As Long
     Dim str_tmp_XS As String

     For I = 1 To VBA.Len(str_XS) Step 1
         str_tmp_XS = str_tmp_XS & VBA.Mid(str_TH, VBA.CInt(VBA.Mid(str_XS, I, 1)) + 1, 1)
     Next I

     If str_tmp_XS = "" Then
         GoTo xsTOstrErr
     End If

     GoTo xsTOstrOKxsTOstrOK:
    Let xsTOstr = str_tmp_XS
    GoTo xsTOstrExitxsTOstrErr:
    Err.Clear
    xsTOstr = ""
    GoTo xsTOstrExitxsTOstrExit:
    str_TH = ""
    I = 0
    str_tmp_XS = ""
    Exit FunctionEnd Function
       以上代码来自： SourceCode Explorer(源代码数据库)
           复制时间： 2002-06-17 20:11:05
           当前版本： 1.0.707
               作者： Shawls
           个人主页： Http://Shawls.Yeah.Net
             E-Mail： [email protected]
                 QQ： 9181729

阿拉伯数字转换成中文Private Function CChinese(StrEng As String) As String
     If Not IsNumeric(StrEng) Or StrEng Like "*.*" Or StrEng Like "*-*" Then
          If Trim(StrEng) <> "" Then MsgBox "无效的数字"
          CChinese = "": 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
     CChinese = strCh
End Function
       以上代码来自： SourceCode Explorer(源代码数据库)
           复制时间： 2002-06-17 20:11:27
           当前版本： 1.0.707
               作者： Shawls
           个人主页： Http://Shawls.Yeah.Net
             E-Mail： [email protected]
                 QQ： 9181729
用VB把数字转成中文字符串数字的读法，写了一个把数字转成中文字符串的程序
参数一为数字
参数二为是不是反回人民币大写
参数三为是不是直接读数字，否则带有十百等单位
参数四为设置小数点后面的位数，默认为4
使用方法是
t=GetChinaNum(20005.000436, , , 7)'返回 “二千零五点零零零四三六”
t=GetChinaNum(2005.436, True, , 7)'返回“贰仟零伍元肆角肆分”
t=GetChinaNum(2005.436, , True, 7)'返加“二零零五点四三六”下面是程序代码Function GetChinaNum(otherNum As Double, Optional isRMB As Boolean, Optional numOption As Boolean, Optional dotNum As Integer) As String
    On Error Resume Next
    num = Trim(Str(Int(otherNum)))

    If isRMB Then
        numwei = "拾佰仟万拾佰仟亿拾佰仟"
        numshu = "零壹贰叁肆伍陆柒捌玖拾"
    Else
        numwei = "十百千万十百千亿十百千"
        numshu = "零一二三四五六七八九十"
    End If
    If otherNum < 20 And otherNum >= 10 Then
        num = Right(num, 1)
        GetChinaNum = Left(numwei, 1)
    End If
    For i = 1 To Len(num)
        bstr = Mid(num, i, 1)
        If numOption Then
            GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1)

        Else
            GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1)
            If bstr = "0" Then
                If Mid(numwei, Len(num) - i, 1) = "万" Or Mid(numwei, Len(num) - i, 1) = "亿" Then
                    Do While Right(GetChinaNum, 1) = "零"
                        GetChinaNum = Left(GetChinaNum, Len(GetChinaNum) - 1)
                    Loop
                    GetChinaNum = GetChinaNum + Mid(numwei, Len(num) - i, 1)
                End If

            Else                GetChinaNum = GetChinaNum + Mid(numwei, Len(num) - i, 1)
            End If
            GetChinaNum = Replace(GetChinaNum, "零零", "零")
        End If
    Next i
    If numOption = False Then
        Do While Right(GetChinaNum, 1) = "零"
            GetChinaNum = Left(GetChinaNum, Len(GetChinaNum) - 1)
        Loop
    End If
    If isRMB Then
        numrmb = "元角分"
        GetChinaNum = GetChinaNum + Mid(numrmb, 1, 1)
        If Val(num) <> otherNum Then
            num = Trim(Str(Round(otherNum - Val(num), 2)))
            For i = 2 To Len(num)
                bstr = Mid(num, i, 1)
                GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1) + Mid(numrmb, i, 1)
            Next i
        Else
            GetChinaNum = GetChinaNum + "整"
        End If
    Else
        If Val(num) <> otherNum Then
            If dotNum = 0 Then dotNum = 4
            num = Trim(CStr(Round(otherNum - Val(num), dotNum)))
            If GetChinaNum = "" Then GetChinaNum = "零"
            GetChinaNum = GetChinaNum + "点"
            For i = 2 To Len(num)
                bstr = Mid(num, i, 1)
                GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1)
            Next i
        End If
    End If
End Function
       以上代码来自： SourceCode Explorer(源代码数据库)
           复制时间： 2002-06-17 20:11:35
           当前版本： 1.0.707
               作者： Shawls
           个人主页： Http://Shawls.Yeah.Net
             E-Mail： [email protected]
                 QQ： 9181729

数字->中文/日期->中文Option ExplicitPrivate Function Date2CN(sDate As String, Optional Flags As Boolean = False) As String
Dim TrueDate As String
Dim Year As String, Month As String, Day As String
Dim CNStr As String
Dim Result As String
Dim Ten As String
    CNStr = IIf(Flags, "零壹贰叁肆伍陆柒捌玖拾", "○一二三四五六七八九十")
    Ten = Mid(CNStr, 11, 1)
    TrueDate = Format(sDate, "yyyy-m-d")
    If Not IsDate(TrueDate) Then
        Date2CN = sDate
        Exit Function
    End If
    Year = DatePart("yyyy", TrueDate)
    Month = DatePart("m", TrueDate)
    Day = DatePart("d", TrueDate)
    Result = Num2CN(Year, Flags) & "年"
    If Len(Month) = 2 Then
        If Right(Month, 1) <> "0" Then
            Result = Result & Ten & Num2CN(Right(Month, 1), Flags)
        Else
            Result = Result & Ten
        End If
    Else
        Result = Result & Num2CN(Month, Flags)
    End If
    Result = Result & "月"
    Select Case Val(Day)
        Case 1 To 9
            Result = Result & Num2CN(Day, Flags)
        Case 10
            Result = Result & Ten
        Case 20, 30
            Result = Result & Num2CN(Left(Day, 1), Flags) & Ten
        Case 11 To 19
            Result = Result & Ten & Num2CN(Right(Day, 1), Flags)
        Case 21 To 31
            Result = Result & Num2CN(Left(Day, 1), Flags) & Ten & Num2CN(Right(Day, 1), Flags)
    End Select
    Date2CN = Result & "日"
End FunctionPrivate Function Num2CN(sNum As Variant, Optional Flags As Boolean = False) As String
Dim Result As String
Dim CNStr As String
Dim i As Integer
Dim TempNum As String
    CNStr = IIf(Flags, "零壹贰叁肆伍陆柒捌玖拾", "○一二三四五六七八九十")
    For i = 1 To Len(CStr(sNum))
        TempNum = Mid(CStr(sNum), i, 1)
        If IsNumeric(TempNum) Then
            Result = Result & Mid(CNStr, Val(TempNum) + 1, 1)
        Else
            Result = Result & TempNum
        End If
    Next
    Num2CN = Result
End FunctionPrivate Sub Command1_Click()
MsgBox Date2CN(IIf(Text1.Text = "", Now, Text1.Text), False)
End Sub
       以上代码来自： SourceCode Explorer(源代码数据库)
           复制时间： 2002-06-17 20:11:43
           当前版本： 1.0.707
               作者： Shawls
           个人主页： Http://Shawls.Yeah.Net
             E-Mail： [email protected]
                 QQ： 9181729注意：除一个回复是我自己写的以外，其他的，没有测试

我写的函数，可以直接使用，数字转化为大写人民币，完全符合中文习惯Public Function rmb(num As Double) As String
num = FormatNumber(num, 2)
Dim numList As String
Dim rmbList As String
Dim numLen
Dim numChar
Dim n1, n2 As String
numList = "零壹贰叁肆伍陆柒捌玖"
rmbList = "分角元拾佰仟万拾佰仟亿拾佰仟万"If num > 9999999999999.99 Then
    rmb = "超出范围的人民币值"
    Exit Function
End IfnumStr = CStr(num * 100)
'MsgBox numStr
numLen = Len(numStr)
'MsgBox numLen
i = 1
Do While i <= numLen
    numChar = CInt(Mid(numStr, i, 1))
    'MsgBox numChar
    n1 = Mid(numList, numChar + 1, 1)
    n2 = Mid(rmbList, numLen - i + 1, 1)
    If Not n1 = "零" Then
        hz = hz + CStr(n1) + CStr(n2)
    Else
        If n2 = "亿" Or n2 = "万" Or n2 = "元" Or n1 = "零" Then
            Do While Right(hz, 1) = "零"
            hz = Left(hz, Len(hz) - 1)
            Loop
        End If
        If (n2 = "亿" Or (n2 = "万" And Right(hz, 1) <> "亿") Or n2 = "元") Then
            hz = hz + CStr(n2)
        Else
            If Left(Right(hz, 2), 1) = "零" Or Right(hz, 1) <> "亿" Then
                hz = hz + n1
            End If
        End If
    End If
    i = i + 1
Loop
Do While Right(hz, 1) = "零"
    hz = Left(hz, Len(hz) - 1)
Loop
If Right(hz, 1) = "元" Then
    hz = hz + "整"
End If
rmb = hz
End Function

告查贴者:
数字转人民币大写:
http://qianfeng.diy.163.com/Num2RMB.zip
有个dll和使用说明,直接使用,无需重复劳动.

调试易

哪位有现成的小写金额转大写程序或函数FOR VB

解决方案 »