将阿拉伯数字转换为人民币大、小写金额？

13907933959

413191246se 发表于 2016-8-30 20:46
139：按照《正确填写票据和结算凭证的基本规定》的规定，你我的写法都是对的，但你非要“零”，所以按照你 ...

师傅好！

在整理诊所的早期帐簿中，发现有十几本帐簿里面的金额数字，只有中文大写或小写的金额数字，没有阿拉伯的数字，现在要在这些大写、小写的金额数字前面或后面，增加阿拉伯的数字，师傅有不有办法实现？附件我省得重做，还是用原来的附件改了一下模拟。

13907933959

413191246se 发表于 2016-8-30 20:46
139：按照《正确填写票据和结算凭证的基本规定》的规定，你我的写法都是对的，但你非要“零”，所以按照你 ...

师傅好！
两个宏中，这个人民币的符号 “￥” 后面加上 ：变为 “￥：” 在代码中要怎样修改？

413191246se

1. Sub 人民币中文大写转阿拉伯数字()
   
2.     Dim n As Long, i As String, j As String
   
3.     If MsgBox("阿拉伯数字是否放在大写前面？（否则后面）", vbYesNo + vbExclamation, "人民币中文大写转阿拉伯数字") = vbYes Then n = 1 Else n = 0
   
4.     ActiveDocument.Content = ActiveDocument.Content & "`"
   
5.     Selection.HomeKey Unit:=wdStory
   
6.     Do
   
7.         Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
   
8.         If Selection = "`" Then Exit Do
   
9.         Do While Selection.Characters.Last Like "[壹贰叁肆伍陆柒捌玖零亿万仟佰拾元圆角分整]"
   
10.             Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    
11.             If Selection.Characters.Last Like "[!壹贰叁肆伍陆柒捌玖零亿万仟佰拾元圆角分整]" Then
    
12.                 Selection.MoveEnd Unit:=wdCharacter, Count:=-1
    
13.                 If Selection Like "元*" Then Selection.MoveStart Unit:=wdCharacter, Count:=1
    
14. '
    
15.                 Selection.Font.Bold = True '加粗
    
16.                 Selection.Font.Color = wdColorBlue '蓝色
    
17.                 Selection.Font.Underline = wdUnderlineWavyHeavy '重波浪线
    
18. '
    
19.                 i = Selection.Text
    
20.                 i = Replace(i, "圆", "元")
    
21.                 i = Replace(i, "拾元", "0.")
    
22.                 If i Like "*仟元整" Then i = Replace(i, "仟元整", "000")
    
23.                 If i Like "*仟元零*" Then i = Replace(i, "仟元零", "000.")
    
24.                 If i Like "*零?角*" Then i = Replace(i, "零", "")
    
25.                 If i Like "*角" Then i = Replace(i, "角", "0")
    
26.                 If i Like "*元整" Then i = Replace(i, "元整", "")
    
27.                 i = Replace(i, "壹", "1")
    
28.                 i = Replace(i, "贰", "2")
    
29.                 i = Replace(i, "叁", "3")
    
30.                 i = Replace(i, "肆", "4")
    
31.                 i = Replace(i, "伍", "5")
    
32.                 i = Replace(i, "陆", "6")
    
33.                 i = Replace(i, "柒", "7")
    
34.                 i = Replace(i, "捌", "8")
    
35.                 i = Replace(i, "玖", "9")
    
36.                 i = Replace(i, "零", "0")
    
37.                 i = Replace(i, "亿", "")
    
38.                 i = Replace(i, "万", "")
    
39.                 i = Replace(i, "仟", "")
    
40.                 i = Replace(i, "佰", "")
    
41.                 i = Replace(i, "拾", "")
    
42.                 i = Replace(i, "元", ".")
    
43.                 i = Replace(i, "角", "")
    
44.                 i = Replace(i, "分", "")
    
45.                 i = Replace(i, "整", "")
    
46.                 j = "（￥：" & i & "元）"
    
47.                 If n = 1 Then Selection.InsertBefore Text:=vbCr & j Else Selection.InsertAfter Text:=j & vbCr
    
48.                 Exit Do
    
49.             End If
    
50.         Loop
    
51.         Selection.MoveRight Unit:=wdCharacter, Count:=1
    
52.     Loop
    
53.     Selection.Delete: Selection.TypeBackspace
    
54. End Sub

复制代码

13907933959

413191246se 发表于 2016-9-6 18:35

师傅好！
师傅辛苦了！刚测试了，转换的阿拉伯数字准确无误，就是每组数字无纶在大写数字金额的前或后，都会改变文档原来的格式、另起一行，师傅有不有办法优化它，让它保持文档原来的格式不变？
另外、求师傅再给一个、小写数字金额转阿拉伯数字的宏。谢谢！

413191246se

139：为方便测试才故意加的回车，可以去掉的（另外格式如蓝色/下划线之类的，最终可以不要的）；另外应该多举一些带“零”字样的数字例子，这样才全面。等此大写宏OK了，小写自然就OK！——请重新做一个模拟附件吧（多带“零”字样）！

13907933959

413191246se 发表于 2016-9-7 09:38
139：为方便测试才故意加的回车，可以去掉的（另外格式如蓝色/下划线之类的，最终可以不要的）；另外应该多 ...

师傅好！

不出您所料，数字添加零后果然出错，附件中标红的数字转换后出错。

请师傅测试附件！

ExcelAPInet

不用VBA，仅用Excel网络函数库RMBUpper()就可以

413191246se

楼上朋友，VBA宏可以把分散在WORD全文中的“数字+元”小写转换为大写人民币，不能集中处理的。