在水晶报表中添加转换金额大写功能

在水晶报表中也是可以添加函数的

在报表空白出右键----报表----公式工作室

在报表自定义函数中就可以增加自己的函数了

Function   AmountToWord2(dblAmount   As   Double)   As   String   

dim strValue as string          

strValue=cstr(dblAmount)

strValue=replace(strValue,",","")

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

    '整数位

    intLenInt=intDecPos-1

    strInt=mid(strValue,1,intLenInt)

    '小数位

    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) 

            'if ToNumber(mid(strInt,intIndex,1))>0 then 

                strIntB=strIntB + "万"

            'end if

        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)        

            'if ToNumber(mid(strInt,intIndex,1))>0 then 

                strIntB=strIntB + "亿"                

            'end if

        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万","万")

'小数处理

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) +"分"                   

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,"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","玖")

AmountToWord2=strValueB

End   Function

以上代码原始作者不详