实现金额大小写转换的VBA自定义函数

此金额大小写转换函数适用Access\Excel\Word等VBA开发，可利用在窗体界面控件显示，亦可以在设计报表里使用，实现大写金额显示。首先按Alt+F11进入VBA编辑界面，新建一个模块，输入以下代码：

Public Function MoneyConv(Money As Currency) As String
On Error GoTo Doerr
    Dim CN(9) As String
    Dim CU(15) As String
    Dim Temp As String, strNum As String
    Dim CM As String
    Dim tFirst As String, tEnd As String
    Dim i As Long, j As Long, k As Long
    CN(0) = "零"
    CN(1) = "壹"
    CN(2) = "贰"
    CN(3) = "叁"
    CN(4) = "肆"
    CN(5) = "伍"
    CN(6) = "陆"
    CN(7) = "柒"
    CN(8) = "捌"
    CN(9) = "玖"
    
'    CU(0) = "分"
'    CU(1) = "角"
    CU(0) = "圆"
    CU(1) = "十"
    CU(2) = "佰"
    CU(3) = "仟"
    CU(4) = "万"
    CU(5) = "十"
    CU(6) = "佰"
    CU(7) = "仟"
    CU(8) = "亿"
    CU(9) = "十"
    CU(10) = "佰"
    CU(11) = "仟"
    
    If Money = 0 Then
        CM = "零圆整"
        GoTo Complete
    End If
    strNum = Trim(Str(FormatCurrency(Money, 2, vbTrue, vbFalse, vbFalse)))
    If Left(strNum, 1) = "-" Then
        tFirst = "负"
        strNum = Right(strNum, Len(strNum) - 1)
    Else
        tFirst = ""
    End If
    
    i = InStrRev(strNum, ".")
    If i <> 0 Then
        Temp = Right(strNum, i)
        If Len(strNum) - i = 1 Then Temp = Temp + "0"
        CM = CN(CInt(Left(Right(Temp, 2), 1))) + "角" + CN(CInt(Right(Temp, 1))) + "分"
        tEnd = ""
        strNum = Left(strNum, i - 1)
    Else
        tEnd = "整"
    End If
    
    i = 0
    For j = Len(strNum) To 1 Step -1
        k = CInt(Right(Left(strNum, j), 1))
        If k = 0 Then
            If i <> 0 And i <> 4 And i <> 8 Then
                CM = CN(k) + CM
            Else
                CM = CN(k) + CU(i) + CM
            End If
        Else
            CM = CN(k) + CU(i) + CM
        End If
'        CM = CN(k) + CU(i) + CM
        i = i + 1
    Next j
    
    CM = tFirst + CM + tEnd
    CM = Replace(CM, "零零", "零")
    CM = Replace(CM, "零零", "零")
    CM = Replace(CM, "亿零万零圆", "亿圆")
    CM = Replace(CM, "亿零万", "亿零")
    CM = Replace(CM, "万零圆", "万圆")
    CM = Replace(CM, "零亿", "亿")
    CM = Replace(CM, "零万", "万")
    CM = Replace(CM, "零圆", "圆")
    CM = Replace(CM, "零零", "零")
    CM = Replace(CM, "零零", "零")        '重复替换一次
Complete:
    Gerr = 0              '操作成功,无错误发生
    MoneyConv = CM
    Exit Function
Doerr:
    Gerr = -1              '未知错误
Errexit:
    MoneyConv = ""
End Function

调用方法：

=MoneyConv(Sum([金额]))