英文金额大写

Excel英文金额大写VB公式[整理]

Excel英文金额大写VB公式

'****************

'MainFunction*

'****************

FunctionSpellNumber(ByValMyNumber)

DimDollars,Cents,Temp

DimDecimalPlace,Count

ReDimPlace(9)AsString

Place(2)="Thousand"

Place(3)="Million"

Place(4)="Billion"

Place(5)="Trillion"

'Stringreprentationofamount.

MyNumber=Trim(Str(MyNumber))

'Positionofdecimalplace0ifnone.

DecimalPlace=InStr(MyNumber,".")

'ConvertcentsandtMyNumbertodollaramount.

IfDecimalPlace>0Then

Cents=GetTens(Left(Mid(MyNumber,DecimalPlace+1)&"00",2))

MyNumber=Trim(Left(MyNumber,DecimalPlace-1))

EndIf

Count=1

DoWhileMyNumber<>""

Temp=GetHundreds(Right(MyNumber,3))

IfTemp<>""ThenDollars=Temp&Place(Count)&Dollars

IfLen(MyNumber)>3Then

MyNumber=Left(MyNumber,Len(MyNumber)-3)

El

MyNumber=""

EndIf

Count=Count+1

Loop

SelectCaDollars

Ca""

Dollars="sZero"

Ca"One"

Dollars="sOne"

CaEl

Dollars="s"&Dollars

EndSelect

SelectCaCents

Ca""

Cents="andCentsZero"

Ca"One"

Cents="andOneCent"

CaEl

Cents="andCents"&Cents

EndSelect

SpellNumber="Say"&Dollars&Cents&"Only***"

SpellNumber=UCa(SpellNumber)

EndFunction

'*******************************************

'Convertsanumberfrom100-999intotext*

'*******************************************

FunctionGetHundreds(ByValMyNumber)

DimResultAsString

IfVal(MyNumber)=0ThenExitFunction

MyNumber=Right("000"&MyNumber,3)

'Convertthehundredsplace.

IfMid(MyNumber,1,1)<>"0"Then

Result=GetDigit(Mid(MyNumber,1,1))&"Hundred"

EndIf

'Convertthetensandonesplace.

IfMid(MyNumber,2,1)<>"0"Then

Result=Result&GetTens(Mid(MyNumber,2))

El

Result=Result&GetDigit(Mid(MyNumber,3))

EndIf

GetHundreds=Result

EndFunction

'*********************************************

'Convertsanumberfrom10to99intotext.*

'*********************************************

FunctionGetTens(TensText)

DimResultAsString

Result=""'Nulloutthetemporaryfunctionvalue.

IfVal(Left(TensText,1))=1Then'Ifvaluebetween10-19...

SelectCaVal(TensText)

Ca10:Result="Ten"

Ca11:Result="Eleven"

Ca12:Result="Twelve"

Ca13:Result="Thirteen"

Ca14:Result="Fourteen"

Ca15:Result="Fifteen"

Ca16:Result="Sixteen"

Ca17:Result="Seventeen"

Ca18:Result="Eighteen"

Ca19:Result="Nineteen"

CaEl

EndSelect

El'Ifvalue

between20-99...

SelectCaVal(Left(TensText,1))

Ca2:Result="Twenty"

Ca3:Result="Thirty"

Ca4:Result="Forty"

Ca5:Result="Fifty"

Ca6:Result="Sixty"

Ca7:Result="Seventy"

Ca8:Result="Eighty"

Ca9:Result="Ninety"

CaEl

EndSelect

Result=Result&GetDigit(Right(TensText,1))

'Retrieveonesplace.

EndIf

GetTens=Result

EndFunction

'*******************************************

'Convertsanumberfrom1to9intotext.*

'*******************************************

FunctionGetDigit(Digit)

SelectCaVal(Digit)

Ca1:GetDigit="One"

Ca2:GetDigit="Two"

Ca3:GetDigit="Three"

Ca4:GetDigit="Four"

Ca5:GetDigit="Five"

Ca6:GetDigit="Six"

Ca7:GetDigit="Seven"

Ca8:GetDigit="Eight"

Ca9:GetDigit="Nine"

CaEl:GetDigit=""

EndSelect

EndFunction