水晶报表 使用公式 转化大写

Dim x As String
Dim y As String
Dim zimu as String
Dim temp As String
Dim letter As String
Dim upcase As String
Dim i as Number
dim j as Number

  zimu = ".sbqwsbqysbqwsbq" '定义位置代码
  letter = "0123456789sbqwy.zjf" '定义汉字缩写
  upcase = "零壹贰叁肆伍陆柒捌玖拾佰仟万亿元整角分" '定义大写汉字

  temp = ToText ({View_Sale_Instead_Pay_Head.Pay_Amount})
  temp = Replace(temp,",","")
  x=temp
  y=""

        For i = 1 To Len(x) - 3
                y = y & Mid(x, i, 1) & Mid(zimu, Len(x) - 2 - i, 1)
        Next
        If Right(x, 3) = ".00" Then
                y = y & "z"          '***元整
        Else
                y = y & Left(Right(x, 2), 1) & "j" & Right(x, 1) & "f"     '*元*角*分
        End If
        y = Replace(y, "0q", "0") '避免零千(如：40200肆萬零千零贰佰)
        y = Replace(y, "0b", "0") '避免零百(如：41000肆萬壹千零佰)
        y = Replace(y, "0s", "0") '避免零十(如：204贰佰零拾零肆)
       
        Do While y <> Replace(y, "00", "0")
                y = Replace(y, "00", "0") '避免双零(如：1004壹仟零零肆)
        Loop
       
        y = Replace(y, "0y", "y") '避免零億(如：210億     贰佰壹十零億)
        y = Replace(y, "0w", "w") '避免零萬(如：210萬     贰佰壹十零萬)
       
        '避免壹十(如：14壹拾肆；10壹拾)
        If Len(x) = 5 And Left(y, 1) = "1" Then
                y = Right(y, Len(y) - 1)
        End If
       
        '避免零元(如：20.00贰拾零圆；0.12零圆壹角贰分)
        If Len(x) = 4 Then
                y = Replace(y, "0.", "")
        End If
       
        For i = 1 To 19
                y = Replace(y, Mid(letter, i, 1), Mid(upcase, i, 1)) '大写汉字
        Next i
        'Com_NumberToCapital = y
        'Msgbox Com_NumberToCapital, 64, "错误提示"
       
        y = Replace(y, "零元", "元")
        y = Replace(y, "零角", "零")
        y = Replace(y, "零分", "")

formula = "人民币" & y