vb怎样小写人民币转大写,例如:28.30转换为零仟零伯贰拾捌圆叁角零分

我见过这样的程序，等找到了再回答你一时找不到那本书了，所以自己写了一个，已经测试，可用。命名可能不是太规范，你可以再做一些修整。源程序如下：option explicitpublic function numbertocharacter(number as string) as string '完成转换的主函数 dim pos_point as long '记录小数点的位置 dim curnum as string '记录当前处理的数字 dim zhengshu as string '记录整数部分 dim shuduan as string '截取某一个数据段 '检索小数点的位置 pos_point = instr(number, ".") '处理小数部分 if pos_point = 0 then '没有小数点，将小数点设置在最末尾 pos_point = len(number) elseif len(number) = pos_point then '以小数点结尾，不作处理 elseif len(number) = pos_point + 1 then '一位小数，直接翻译为角 curnum = right(number, 1) numbertocharacter = numtochr(curnum) & "角" elseif len(number) = pos_point + 2 then '取第一位 curnum = right(number, 1) '若第一位为零，则不作处理，否则译为“角” if curnum <> "0" then numbertocharacter = numtochr(curnum) & "分" end if '取第二位 curnum = left(right(number, 2), 1) '若第二为零，不作处理，否则译为“分” if curnum <> "0" then numbertocharacter = numtochr(curnum) & "角" & numbertocharacter end if end if '处理整数 zhengshu = "" if pos_point > 14 then '大于 9999999999999 的数据不转换 msgbox "该数据无法转换", vbokonly + vb**rmation, "金额转换" exit function elseif pos_point > 9 then zhengshu = "亿" '亿位以上的部分 shuduan = left(number, pos_point - 9) zhengshu = shuduantocharacter(shuduan) & zhengshu '万位以上的部分 shuduan = right(left(number, pos_point - 5), 4) zhengshu = zhengshu & shuduantocharacter(shuduan) & "万" '万位以下部分 shuduan = right(left(number, pos_point - 1), 4) zhengshu = zhengshu & shuduantocharacter(shuduan) & "圆" elseif pos_point > 5 then '万位以上的部分 shuduan = right(left(number, pos_point - 5), 4) zhengshu = zhengshu & shuduantocharacter(shuduan) & "万" '万位以下部分 shuduan = right(left(number, pos_point - 1), 4) zhengshu = zhengshu & shuduantocharacter(shuduan) & "圆" else '万位以下 shuduan = right(left(number, pos_point - 1), 4) zhengshu = zhengshu & shuduantocharacter(shuduan) & "圆" end if numbertocharacter = zhengshu & numbertocharacter '输入为“0”，特殊处理 if numbertocharacter = "圆" then numbertocharacter = "零圆" end ifend functionpublic function numtochr(num as string) as string '数字转化为对应的中文 select case num case "1" numtochr = "壹" case "2" numtochr = "贰" case "3" numtochr = "参" case "4" numtochr = "肆" case "5" numtochr = "伍" case "6" numtochr = "陆" case "7" numtochr = "柒" case "8" numtochr = "捌" case "9" numtochr = "玖" case "0" numtochr = "零" end select end function'对分节后的每一节数据进行翻译，'例如: 1234512341234被分为12345，1234，1234public function shuduantocharacter(duan as string) as string dim curnum as string dim answer as string answer = "" if len(duan) = 5 then '有万位 answer = numtochr(left(duan, 1)) & "万" '千位 curnum = right(left(duan, 2), 1) if curnum <> "0" then answer = answer & numtochr(curnum) & "仟" else answer = answer & "零" end if '百位 curnum = right(left(duan, 3), 1) if curnum <> "0" then answer = answer & numtochr(curnum) & "佰" else if right(answer, 1) <> "零" then answer = answer & "零" end if end if '十位 curnum = right(left(duan, 4), 1) if curnum <> "0" then answer = answer & numtochr(curnum) & "拾" else if right(answer, 1) <> "零" then answer = answer & "零" end if end if '个位 curnum = right(duan, 1) if curnum <> "0" then answer = answer & numtochr(curnum) else if right(answer, 1) = "零" then answer = left(answer, len(answer) - 1) end if end if elseif len(duan) = 4 then '有千位 answer = numtochr(left(duan, 1)) & "仟" '百位 curnum = left(right(duan, 3), 1) if curnum <> "0" then answer = answer & numtochr(curnum) & "佰" else if right(answer, 1) <> "零" then answer = answer & "零" end if end if '十位 curnum = left(right(duan, 2), 1) if curnum <> "0" then answer = answer & numtochr(curnum) & "拾" else if right(answer, 1) <> "零" then answer = answer & "零" end if end if '个位 curnum = right(duan, 1) if curnum <> "0" then answer = answer & numtochr(curnum) else if right(answer, 1) = "零" then answer = left(answer, len(answer) - 1) end if end if elseif len(duan) = 3 then '有百位 answer = numtochr(left(duan, 1)) & "佰" '十位 curnum = left(right(duan, 2), 1) if curnum <> "0" then answer = answer & numtochr(curnum) & "拾" else if right(answer, 1) <> "零" then answer = answer & "零" end if end if '个位 curnum = right(duan, 1) if curnum <> "0" then answer = answer & numtochr(curnum) else if right(answer, 1) = "零" then answer = left(answer, len(answer) - 1) end if end if elseif len(duan) = 2 then '有十位 answer = numtochr(left(duan, 1)) & "拾" '个位 curnum = right(duan, 1) if curnum <> "0" then answer = answer & numtochr(curnum) else if right(answer, 1) = "零" then answer = left(answer, len(answer) - 1) end if end if elseif len(duan) = 1 then '有个位 answer = numtochr(left(duan, 1)) end if shuduantocharacter = answerend function 20210311