04.02.03.tiptop：基础知识篇（水晶报表：函数 金额大写）

本页目录：

• 1、新建函数
• 2、引用函数
• 3、测试

---

新建函数

Function RMB(StrValue As String) As String
    Dim StrHead As String
    IF LENGTH(Replace(StrValue, "-","")) <> LENGTH(StrValue) THEN
        StrHead="负"
    ELSE
        StrHead=""
    End If
    ' 将"数字"转换为"字符串"待处理.
    StrValue=Replace(StrValue, "-","")
    If StrValue="0.00" Then
        RMB="零元整"
        Exit Function
    End If
    ' 字符长度(总长度)
    Dim IntLenValue As Number
    IntLenValue = Len(StrValue)
    ' 小数点的位置
    Dim IntDecPos As Number
    IntDecPos = InStr(StrValue, ".")
    ' 整数的字符及长度
    Dim StrInt As String
    Dim IntLenInt As Number
    ' 小数的字符及长度
    Dim StrDec As String
    Dim IntLenDec As Number
    ' 判断是否有小数存在.
    If IntDecPos > 0 Then
        ' 整数位
        If IntDecPos = 1 Then
            IntLenInt = 1
            StrInt = "0"
        Else
            IntLenInt = IntDecPos - 1
            StrInt = Mid(StrValue, 1, IntLenInt)
        End If
        ' 小数位
        IntLenDec = IntLenValue - (IntDecPos + 1) + 1
        StrDec = Mid(StrValue, IntDecPos + 1, IntLenDec)
    Else
        IntLenInt = IntLenValue
        StrInt = StrValue
    End If
    ' 开始处理. (注意: 只能计算 1 兆以下的金额)
    Dim I As Number
    I = 1
    ' 整数位处理
    Dim StrIntB As String
    StrIntB = ""
    Dim IntIndex As Number
    IntIndex = 1
    For I = IntLenInt To 1 Step -1
    IntIndex = IntLenInt - I + 1
    Select Case I
        Case 1
            If ToNumber(Mid(StrInt, IntIndex, 1) ) > 0 Then StrIntB = StrIntB +Mid(StrInt, IntIndex, 1)
        Case 2
            StrIntB = StrIntB + Mid(StrInt, IntIndex, 1)
            If ToNumber(Mid(StrInt, IntIndex, 1) ) > 0 Then StrIntB = StrIntB +"拾"
        Case 3
           StrIntB = StrIntB + Mid(StrInt, IntIndex, 1)
           If ToNumber(Mid(StrInt, IntIndex, 1) ) > 0 Then StrIntB = StrIntB +"佰"
        Case 4
           StrIntB = StrIntB + Mid(StrInt, IntIndex, 1)
           If ToNumber(Mid(StrInt, IntIndex, 1) ) > 0 Then StrIntB = StrIntB +"仟"
        Case 5
           StrIntB = StrIntB + Mid(StrInt, IntIndex, 1)
           StrIntB = StrIntB + "万"
        Case 6
           StrIntB = StrIntB + Mid(StrInt, IntIndex, 1)
           If ToNumber(Mid(StrInt, IntIndex, 1) ) > 0 Then StrIntB = StrIntB +"拾"
        Case 7
           StrIntB = StrIntB + Mid(StrInt, IntIndex, 1)
           If ToNumber(Mid(StrInt, IntIndex, 1) ) > 0 Then StrIntB = StrIntB +"佰"
        Case 8
           StrIntB = StrIntB + Mid(StrInt, IntIndex, 1)
           If ToNumber(Mid(StrInt, IntIndex, 1) ) > 0 Then StrIntB = StrIntB +"仟"
        Case 9
           StrIntB = StrIntB + Mid(StrInt, IntIndex, 1)
           StrIntB = StrIntB + "亿"
        Case 10
           StrIntB = StrIntB + Mid(StrInt, IntIndex, 1)
           If ToNumber(Mid(StrInt, IntIndex, 1) ) > 0 Then StrIntB = StrIntB +"拾"
        Case 11
           StrIntB = StrIntB + Mid(StrInt, IntIndex, 1)
           If ToNumber(Mid(StrInt, IntIndex, 1) ) > 0 Then StrIntB = StrIntB +"佰"
        Case 12
           StrIntB = StrIntB + Mid(StrInt, IntIndex, 1)
           If ToNumber(Mid(StrInt, IntIndex, 1) ) > 0 Then StrIntB = StrIntB +"仟"
    End Select
Next I
    If StrIntB <> "" Then
        StrIntB = StrIntB + "元"
    End If
    ' 是否显示壹拾(一般要显示)
    ' StrIntB = Replace(StrIntB, "1 拾", "拾")
    For I = 1 To 10
        StrIntB = Replace(StrIntB, "00", "0")
    Next I
        StrIntB = Replace(StrIntB, "0 元", "元")
        StrIntB = Replace(StrIntB, "0 万", "万零") ' 102000 应该是--壹拾万零贰仟元整
        ' 小数处理
        Dim StrDecB As String
        StrDecB = ""
        I = 1
        Select Case IntLenDec
            Case 1
                ' # --> #角
                If ToNumber(Mid(StrDec, I, 1) ) > 0 Then StrDecB = StrDec + "角整"
            Case 2
                ' ## --> #角#分
                If StrIntB <> "" Then
                     StrDecB = StrDecB + Mid(StrDec, I, 1)
                     If ToNumber(Mid(StrDec, I, 1) ) > 0 Then StrDecB = StrDecB + "角"
                Else
                    If ToNumber(Mid(StrDec, I, 1) ) > 0 Then StrDecB = StrDecB +Mid(StrDec, I, 1) + "角"
                End If
                I = I + 1
                If ToNumber(Mid(StrDec, I, 1) ) > 0 Then
                    StrDecB = StrDecB + Mid(StrDec, I, 1) + "分"
                Else
                    If StrDecB <> "0" Then StrDecB = StrDecB + "整"
                End If
         End Select
         If StrDecB = "0" Then StrDecB = ""
         Dim StrValueB As String
         If StrDecB <> "" Then
            StrValueB = StrIntB + StrDecB
         Else
            If StrIntB <> "" Then
                StrValueB = StrIntB + "整"
            Else
                StrValueB = StrIntB + "0 元整"
            End If
          End If
StrValueB = Replace(StrValueB, "0 元", "零元")
StrValueB = Replace(StrValueB, "0 亿", "亿")
StrValueB = Replace(StrValueB, "亿万", "亿")
StrValueB = Replace(StrValueB, "0", "零")
StrValueB = Replace(StrValueB, "1", "壹")
StrValueB = Replace(StrValueB, "2", "贰")
StrValueB = Replace(StrValueB, "3", "叁")
StrValueB = Replace(StrValueB, "4", "肆")
StrValueB = Replace(StrValueB, "5", "伍")
StrValueB = Replace(StrValueB, "6", "陆")
StrValueB = Replace(StrValueB, "7", "柒")
StrValueB = Replace(StrValueB, "8", "捌")
StrValueB = Replace(StrValueB, "9", "玖")
StrValueB = Replace(StrValueB, "亿零元", "亿元")
StrValueB = Replace(StrValueB, "万零元", "万元")
' 返回大写金额
RMB=StrHead+StrValueB
End Function

引用函数

RMB (Replace(ToText({#sum_apa34}), ",",""))

测试