【办公-Word-VB】人民币大写转换-带完整注释
完整代码见:我的CSDN博客
--------------------
应公司财务人员的请求,需在Word中做个:输入阿拉伯数字,自动转换成大写,并填充到Word控件中对应的亿、万、千控件格子的功能,特研究VB。
下面是我在网上搜集的将 阿拉伯数字转换为 中文大写的代码,注释为我添加,方便理解,特记录在此。
有机会把带有宏的原Word也发布,供大家参考。
Function mychange(ByVal Myinput) 'MyinputA 去除空白符且变成整数(去掉小数)后的数字串 'MyinputB 翻转后的数字串 'MyinputC 转换为大写的金额 Dim Temp, TempA, MyinputA, MyinputB, MyinputC Dim Place As String Dim J As Integer Place = "分角元拾佰仟万拾佰仟亿拾佰仟万" shuzi1 = "壹贰叁肆伍陆柒捌玖" shuzi2 = "整零元零零零万零零零亿零零零万" qianzhui = "" If Val(Myinput) = 0 Then Myinput = 0 If Myinput = "" Then Myinput = 0 If Myinput < 0 Then qianzhui = "负" '将小数转为整数,去掉小数点, 123.45 -> 12345 Myinput = Int(Abs(Myinput) * 100 + 0.5) If Myinput > 99999999999# Then mychange = "输入有误:数字过大" Exit Function End If If Myinput = 0 Then mychange = "零元零分" Exit Function End If MyinputA = Trim(Str(Myinput)) shuzilong = Len(MyinputA) '翻转金额,12345->54321 For J = 1 To shuzilong MyinputB = Mid(MyinputA, J, 1) & MyinputB Next '1把阿拉伯数字转为大写, 54321, 5->伍 '2将数字和对应位置的单位拼接,伍肆叁贰壹,伍->伍分 '3拼接时翻转回来, 肆角伍分 '注意0:从 shuzi2 得到单位,而不是从 Place ' 12.10->1210->0121-> 整 壹角 贰元 壹拾 ' 10.88->1088->8801->捌分 捌角 元 壹拾 ' 30800.25->3080025->5200803->..贰角 元 零 捌佰 零 叁万 ' ->叁万 零 捌佰 零 元 贰角... For J = 1 To shuzilong Temp = Val(Mid(MyinputB, J, 1)) If Temp = 0 Then MyinputC = Mid(shuzi2, J, 1) & MyinputC Else MyinputC = Mid(shuzi1, Temp, 1) & Mid(Place, J, 1) & MyinputC End If Next '细节:处理零 '10.46 壹拾零元... -> 壹拾元 '10 1234.56 壹拾零万... -> 壹拾万 '10 1234 5678.56壹拾零亿... -> 壹拾亿 '30800.25 上一步得到:叁万 零 捌佰 零 元 贰角伍分 ' 注意并不是:叁万 零仟 捌佰 零拾 零元 贰角伍分 '30800.25 叁万零捌佰(零)元.. -> 叁万零捌佰 元.. shuzilong = Len(MyinputC) For J = 1 To shuzilong - 1 If Mid(MyinputC, J, 1) = "零" Then Select Case Mid(MyinputC, J + 1, 1) Case "零", "元", "万", "亿", "整": MyinputC = left(MyinputC, J - 1) & Mid(MyinputC, J + 1, 30) J = J - 1 End Select End If Next '贰亿万... -> 贰亿... shuzilong = Len(MyinputC) For J = 1 To shuzilong - 1 If Mid(MyinputC, J, 1) = "亿" And Mid(MyinputC, J + 1, 1) = "万" Then MyinputC = left(MyinputC, J) & Mid(MyinputC, J + 2, 30) Exit For End If Next mychange = qianzhui & Trim(MyinputC) End Function