金额大写vb.net 金额大写快捷输入方式

vb.net 如何把大写金额转换成阿拉伯数字金额？

Private Sub Text2_Change() '大写金额转换成阿拉伯数字金额

创新互联公司总部坐落于成都市区，致力网站建设服务有成都网站建设、网站建设、网络营销策划、网页设计、网站维护、公众号搭建、小程序设计、软件开发等为企业提供一整套的信息化建设解决方案。创造真正意义上的网站建设，为互联网品牌在互动行销领域创造价值而不懈努力！

Dim i As Integer

Dim j As Integer

Dim myint As Integer

Dim myint1 As Integer

Dim mydoub As Double

Dim mystr As String

Dim mystr1 As String

Dim mystr2 As String

Dim mystr3 As String

Dim mystr4 As String

Dim money As Long

Dim money1 As Integer

Dim money2 As Long

mystr = Text2.Text

myint = InStr(mystr, ".")

If myint = 0 Then

mystr = Text2.Text

Else

mystr3 = Right(Text2.Text, Len(Text2.Text) - myint)

If mystr3 "" Then '转换小数位

mystr4 = Left(mystr3, 1)

mystr3 = Right(mystr3, Len(mystr3) - 1)

If mystr4 "0" Then

mystr2 = mystr2 + setdata(Val(mystr4)) + "角"

End If

If mystr3 "" Then

mystr4 = Left(mystr3, 1)

mystr2 = mystr2 + setdata(Val(mystr4)) + "分"

End If

End If

mystr = Left(Text2.Text, myint - 1)

End If

j = Len(mystr)

For i = 1 To Len(mystr) '转换整数位

money2 = Left(mystr, i)

money1 = Right(money2, 1)

If money1 = 0 Then

If j = 5 Then

If Right(mystr1, 1) "万" Then mystr1 = mystr1 "万"

Else

If Right(mystr1, 1) "零" And Right(money, j) 0 Then mystr1 = mystr1 "零"

End If

Else

mystr1 = mystr1 setdata(money1) + chang(j)

End If

j = j - 1

Next i

Text1.Text = mystr1 "元" mystr2 '显示大写

End Sub

怎么实现在vb中，金额大小写转换啊？

很容易啊，模块如下：

Function RMBChinese(ByVal Rmb As Double) As String

On Error Resume Next

Dim Rmbexp As String, Rmbda As String, Expda As String, Lent As Integer, Ntyp As Integer, Icnt As Integer, i As Integer, Trmb As String

Rmb = Format(Rmb, "###0.00")

If Rmb  999999999999.99 Then

RMBChinese = "需转换的金额整数长度超过了12位！"

Exit Function

End If

Rmbexp = "分角元拾佰仟万拾佰仟亿拾佰仟"

Rmbda = "零壹贰叁肆伍陆柒捌玖"

Ntyp = 0

Trmb = Replace(CStr(Format(Rmb, "0.00")), ".", "")

If Left(Trmb, 1) = "-" Then

Trmb = Mid(Trmb, 2)

Ntyp = 1

End If

Expda = ""

Icnt = Len(Trmb)

For i = 1 To Icnt

Expda = Mid(Rmbda, Val(Mid(Trmb, Icnt - i + 1, 1)) + 1, 1) + IIf(Mid(Rmbexp, i, 1) = "元", Mid(Rmbexp, i, 1) + " ", Mid(Rmbexp, i, 1)) + Expda

Next

RMBChinese = IIf(Ntyp = 1, "负" + Expda, Expda)

End Function

用vb编制一个将人民币金额（不超过4位整数）转化为大写金额的程序。（1）单击转换（command1）text1是

Private Function setdata(num As Integer) As String  '数字转换

Select Case num

Case 0

setdata = "零"

Case 1

setdata = "壹"

Case 2

setdata = "贰"

Case 3

setdata = "叁"

Case 4

setdata = "肆"

Case 5

setdata = "伍"

Case 6

setdata = "陆"

Case 7

setdata = "柒"

Case 8

setdata = "捌"

Case 9

setdata = "玖"

End Select

End Function

Private Function chang(aaa As Integer) As String  '位数转换

Select Case aaa

Case 1

chang = ""

Case 2

chang = "十"

Case 3

chang = "百"

Case 4

chang = "千"

Case 5

chang = "万"

Case 6

chang = "十"

Case 7

chang = "百"

Case 8

chang = "千"

Case 9

chang = "亿"

Case 10

chang = "十"

End Select

End Function

Private Sub Form_Activate()  '设定文本长度

Text2.MaxLength = 10

Text2.SetFocus

End Sub

Private Sub Text2_Change()  '小写转大写

Dim i As Integer

Dim j As Integer

Dim myint As Integer

Dim myint1 As Integer

Dim mydoub As Double

Dim mystr As String

Dim mystr1 As String

Dim mystr2 As String

Dim mystr3 As String

Dim mystr4 As String

Dim money As Long

Dim money1 As Integer

Dim money2 As Long

mystr = Text2.Text

myint = InStr(mystr, ".")

If myint = 0 Then

mystr = Text2.Text

Else

mystr3 = Right(Text2.Text, Len(Text2.Text) - myint)

If mystr3  "" Then       '转换小数位

mystr4 = Left(mystr3, 1)

mystr3 = Right(mystr3, Len(mystr3) - 1)

If mystr4  "0" Then

mystr2 = mystr2 + setdata(Val(mystr4)) + "角"

End If

If mystr3  "" Then

mystr4 = Left(mystr3, 1)

mystr2 = mystr2 + setdata(Val(mystr4)) + "分"

End If

End If

mystr = Left(Text2.Text, myint - 1)

End If

j = Len(mystr)

For i = 1 To Len(mystr)      '转换整数位

money2 = Left(mystr, i)

money1 = Right(money2, 1)

If money1 = 0 Then

If j = 5 Then

If Right(mystr1, 1)  "万" Then mystr1 = mystr1  "万"

Else

If Right(mystr1, 1)  "零" And Right(money, j)  0 Then mystr1 = mystr1  "零"

End If

Else

mystr1 = mystr1  setdata(money1) + chang(j)

End If

j = j - 1

Next i

Text1.Text = mystr1  "元"  mystr2  '显示大写

End Sub

Private Sub Command1_Click()

End

End Sub

求vb金额小写转为大写的代码，带详细注释的！！！！

转自

将阿拉伯数字转换为汉字数字,支持到百万亿(比如大写金额)

例子:

Debug.Print UpNumber(-612325646566.46,0,True )

负陆仟壹佰贰拾叁亿贰仟伍佰陆拾肆万陆仟伍佰陆拾陆圆肆角陆分

Debug.Print UpNumber(-125646566.46,1,True )

负一亿二千五百六十四万六千五百六十六元四角六分

Debug.Print UpNumber(-125646566.46,1,flase )

负一亿二千五百六十四万六千五百六十六点四六

Public Function UpNumber(ByVal Number As Double, Optional ByVal Typ As Long, Optional ByVal IsMoney As Boolean) As String

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

'--------------------------------------------------------------------------------

'将阿拉伯数字转换为大写字符串

'--------------------------------------------------------------------------------

'参数说明:

'Number 待转换的数字,可以是小数.

'Typ 转换类型,可选值 0,1

'0 转换为 零,壹,贰 等

'1 转换为 一,二,三 等

'IsMoney 是否是金额,如果是,则转换为多少元,小数后转换为多少角,分,反之则转换为类似于"二点三"这种形式

'--------------------------------------------------------------------------------

'

'--------------------------------------------------------------------------------

'返回值说明:

'如果成功,返回转换后的字符串

'如果失败,返回空字符串

'--------------------------------------------------------------------------------

'

'--------------------------------------------------------------------------------

'注意,由于 Double 类型数值范围的原因,此函数最大只支持到百万亿

'没有对 Typ 的值进行检查,如果 Typ 不为 0,1 之一,将会引发错误.

'另,由于 Double 类型数值范围的原因,超过百万亿,将不能显示小数,同样的超过十万亿只能显示一个小数,以此类推.

'--------------------------------------------------------------------------------

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

On Error GoTo Doerr

Dim Result As String '返回值

Dim strNumber As String '文本型的 Number

Dim lngNumberLen As Long '文本型的 Number 的 Len

Dim strTmp As String

Dim strFirst As String, strEnd As String

Dim lngI As Long, lngJ As Long, lngTmp As Long

Dim strNum(10) As String '大写数字

Dim strUnit(16) As String '单位,比如 十,拾,万等

Dim strUnitB(2) As String '小数后的单位

'初始化

Select Case Typ

Case 0

strNum(0) = "零": strNum(1) = "壹": strNum(2) = "贰": strNum(3) = "叁"

strNum(4) = "肆": strNum(5) = "伍": strNum(6) = "陆": strNum(7) = "柒"

strNum(8) = "捌": strNum(9) = "玖"

If IsMoney Then

strUnit(0) = "圆"

strUnitB(0) = "角": strUnitB(1) = "分"

Else

strUnit(0) = "点"

End If

strUnit(1) = "拾": strUnit(2) = "佰": strUnit(3) = "仟": strUnit(4) = "万"

strUnit(5) = "拾": strUnit(6) = "佰": strUnit(7) = "仟": strUnit(8) = "亿"

strUnit(9) = "拾": strUnit(10) = "佰": strUnit(11) = "仟": strUnit(12) = "万"

strUnit(13) = "拾": strUnit(14) = "佰": strUnit(15) = "仟"

Case 1

strNum(0) = "零": strNum(1) = "一": strNum(2) = "二": strNum(3) = "三"

strNum(4) = "四": strNum(5) = "五": strNum(6) = "六": strNum(7) = "七"

strNum(8) = "八": strNum(9) = "九"

If IsMoney Then

strUnit(0) = "元"

strUnitB(0) = "角": strUnitB(1) = "分"

Else

strUnit(0) = "点"

End If

strUnit(1) = "十": strUnit(2) = "百": strUnit(3) = "千": strUnit(4) = "万"

strUnit(5) = "十": strUnit(6) = "百": strUnit(7) = "千": strUnit(8) = "亿"

strUnit(9) = "十": strUnit(10) = "百": strUnit(11) = "千": strUnit(12) = "万"

strUnit(13) = "十": strUnit(14) = "百": strUnit(15) = "千"

Case Else

'参数错误

GoTo Errexit

End Select

Result = ""

If Number = 0 Then

If IsMoney Then

Result = strNum(0) strUnit(0) "整"

Else

Result = strNum(0)

End If

Else

If IsMoney Then

strNumber = Trim(str(FormatCurrency(Number, 2, vbTrue, vbFalse, vbFalse))) '保留两位小数

Else

strNumber = Trim(str(Number)) '简单的转换为字符串型

End If

lngNumberLen = Len(strNumber)

If Left(strNumber, 1) = "-" Then '处理负数

strFirst = "负"

strNumber = Right(strNumber, lngNumberLen - 1)

lngNumberLen = lngNumberLen - 1

Else

strFirst = "" '通常不需要 =""

End If

lngI = InStrRev(strNumber, ".")

If lngI Then

strTmp = Right(strNumber, lngNumberLen - lngI)

If IsMoney Then

strTmp = strTmp "00"

strEnd = "" '通常不需要 =""

For lngJ = 1 To 2

Result = Result strNum(CLng(Mid$(strTmp, lngJ, 1))) strUnitB(lngJ - 1)

Next

Else

strTmp = Right(strNumber, lngNumberLen - lngI)

For lngJ = 1 To lngNumberLen - lngI

Result = Result strNum(CLng(Mid$(strTmp, lngJ, 1)))

Next

End If

strNumber = Left(strNumber, lngI - 1) '去除小数部分

lngNumberLen = Len(strNumber) '新的字符串长度

Else

If IsMoney Then

strEnd = "整"

Else

strEnd = ""

End If

End If

'以下为主循环部分

lngI = 0

For lngJ = lngNumberLen To 1 Step -1

lngTmp = CLng(Mid$(strNumber, lngJ, 1))

If lngTmp Then

Result = strNum(lngTmp) strUnit(lngI) Result

Else

If lngI = 0 Or lngI = 4 Or lngI = 8 Or lngI = 12 Then '超过 16 位不支持

Result = strNum(lngTmp) strUnit(lngI) Result

Else

Result = strNum(lngTmp) Result

End If

End If

lngI = lngI + 1

Next

Result = Replace(Result, strNum(0) strNum(0), strNum(0)) '零零", "零

Result = Replace(Result, strNum(0) strNum(0), strNum(0)) '零零", "零

'亿零万零圆", "亿圆"

Result = Replace(Result, strUnit(8) strNum(0) strUnit(4) strNum(0) strUnit(0), strUnit(8) strUnit(0))

Result = Replace(Result, strUnit(8) strNum(0) strUnit(4), strUnit(8) strNum(0)) '亿零万, "亿零"

Result = Replace(Result, strUnit(4) strNum(0) strUnit(0), strUnit(4) strUnit(0)) '亿零万", "亿零

Result = Replace(Result, strNum(0) strUnit(8), strUnit(8)) '零亿

Result = Replace(Result, strNum(0) strUnit(4), strUnit(4)) '零万

Result = Replace(Result, strNum(0) strUnit(0), strUnit(0)) '零圆

Result = Replace(Result, strNum(0) strNum(0), strNum(0)) '零零", "零

Result = Replace(Result, strNum(0) strNum(0), strNum(0)) '零零", "零

If IsMoney Then

Result = strFirst Result strEnd

Else

Result = strFirst Result

If Right(Result, 1) = strUnit(0) Then Result = Left(Result, Len(Result) - 1) '去除最后一个 "点"

End If

End If

Complete:

GoTo Quit

Doerr:

Errexit:

Result = ""

Quit:

UpNumber = Result

End Function

用VB.NET实现人民币大小写转换工具 （互相转换）

Public Function je(ByVal szje As Double) As String

Dim s As String = ""

Dim sz() As String = {"零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖"}

Dim dw() As String = {"圆", "拾", "佰", "千", "万", "拾", "佰", "仟", "拾", "佰", "仟"}

If szje 0 Then

s = "负"

szje = Math.Abs(szje)

End If

Dim zh() As String = Split(Str(szje), ".")

If zh.Length 2 Then

Return "ERROR:格式错"

Exit Function

End If

zh(0) = Trim(zh(0))

zh(1) = Trim(zh(1))

Dim i As Integer

For i = 1 To Len(zh(0))

s = s sz(Val(Mid(zh(0), i, 1))) dw(Len(zh(0)) - i)

Next

For i = 1 To Len(zh(1))

s = s sz(Val(Mid(zh(1), i, 1))) Choose(i, "角", "分", "厘", "毫")

Next

s = s "整"

Return s

End Function