* 楼主 的意思,正与我的猜想一致!请试试下面的代码:(请注意:粉红色是为了鲜明核对数据,如果不想要颜色,可以将代码倒数第8行含有“粉红”一行代码删除或屏蔽)
- Sub 人民币中文大写_金额大写()
- ActiveDocument.Content.Find.Execute "金额大写:", , , 1, , , , , , "金额大写:", 2
- Const s As String = "万仟佰拾亿仟佰拾万仟佰拾元角分"
- Dim c&, i$, j&, a$, n&
- c = 0
- With ActiveDocument.Content.Find
- .ClearFormatting
- .Text = "金额大写:[0-9. ^s^t,,]{1,}"
- .Forward = True
- .MatchWildcards = True
- Do While .Execute
- With .Parent
- .MoveStart 1, 5
- i = .Text
- i = Replace(i, " ", "")
- i = Replace(i, " ", "")
- i = Replace(i, vbTab, "")
- i = Replace(i, ChrW(160), "")
- i = Replace(i, ",", "")
- i = Replace(i, ",", "")
- If i Like "*.*.*" Then .Font.Color = wdColorRed: GoTo sk
- i = Format(i, "Standard")
- i = Replace(i, ",", "")
- i = Replace(i, ".", "")
- j = Len(i)
- If j > 15 Then GoTo sk
- a = ""
- For n = 1 To j
- a = a & Mid(i, n, 1) & Mid(s, 15 - j + n, 1)
- Next n
- a = Replace(a, "1", "壹")
- a = Replace(a, "2", "贰")
- a = Replace(a, "3", "叁")
- a = Replace(a, "4", "肆")
- a = Replace(a, "5", "伍")
- a = Replace(a, "6", "陆")
- a = Replace(a, "7", "柒")
- a = Replace(a, "8", "捌")
- a = Replace(a, "9", "玖")
- a = Replace(a, "0", "零")
- '''
- a = Replace(a, "零仟", "零")
- a = Replace(a, "零佰", "零")
- a = Replace(a, "零拾", "零")
- Do While a Like "*零零*"
- a = Replace(a, "零零", "零")
- Loop
- a = Replace(a, "零亿", "亿零")
- a = Replace(a, "零万", "万零")
- a = Replace(a, "零元", "元零")
- Do While a Like "*零零*"
- a = Replace(a, "零零", "零")
- Loop
- a = Replace(a, "零角零分", "整")
- a = Replace(a, "零角", "零")
- a = Replace(a, "零分", "")
- If a Like "元零*" Then a = Replace(a, "元零", "")
- If a = "元整" Then a = "零" & a
- If a Like "*万零元*" And Val(a) < 100000000 Then a = Replace(a, "万零元", "万元") '10万<=X<1亿
- a = Replace(a, "亿万", "亿")
- If a Like "*亿零万*" Then a = Replace(a, "零万", "") '>=10亿
- '''
- If c = 1 Then
- .InsertBefore Text:="(人民币" & a & ")"
- Else
- .Delete
- .InsertAfter Text:=a
- .Font.Color = wdColorPink '粉红(本行代码可删除/屏蔽)
- End If
- sk:
- .Start = .End
- End With
- Loop
- End With
- End Sub
复制代码 |