[原创]WORD中的人民币大写

hlrong

以前见过的人民币大写转换函数都是EXCEL版本的，好象高手们都对WORD大写转换都不感兴趣，其实作为经济工作者，或是与制式合同打交道的财务人员，应该说还是经常会接触到小写金额转人民币大写的问题，如能有相应快速转换办法，亦能小提工作效率。本人愚笨，写了个小程序，还请高手指点。

Sub 人民币大写()

Dim Seltxt As String

Dim Zx As Double, Xx As Double

Dim Selcase As String

Seltxt = Selection.Text

Zx = Int(Val(Seltxt))

Xx = (Round(Val(Seltxt), 2) - Zx) * 100

Gxs = "= " + Str(Zx) + " \* Chinesenum2"

Selection.Moveright Unit:=Wdcharacter, Count:=1

Set Ym = Selection.Fields.Add(Range:=Selection.Range, Text:=Gxs)

Selcase = Ym.Result + "元"

Gxs = "= " + Str(Xx) + " \* Chinesenum2"

Set Ym = Selection.Fields.Add(Range:=Selection.Range, Text:=Gxs)

Xxcase = Ym.Result

Selection.Moveleft Unit:=Wdcharacter, Count:=2, Extend:=Wdextend

Selection.Delete

Select Case Xx

Case 0

Selcase = Selcase + "整"

Case 1 To 9

Selcase = Selcase + "零" + Xxcase + "分"

Case 10 To 99

If (Xx Mod 10) = 0 Then

Selcase = Selcase + Left(Xxcase, 1) + "角整"

Else

Selcase = Selcase + Left(Xxcase, 1) + "角" + Right(Xxcase, 1) + "分"

End If

End Select

Selection.Text = Selcase

End Sub

[此贴子已经被作者于2004-3-10 21:33:50编辑过]

kelchen

版主自称愚笨，呵呵~~我连你写的都看不懂！

matsumi

苦索很久,终于有希望了,如何使用?我放在模块中,运行宏时,告知有几个变量未定义, 还有Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtendSub 人民币大写()为红字,望楼主指教!

办公之星

　 　　也是看不懂啊......

hlrong

以下是引用matsumi在2004-3-12 14:12:00的发言：
苦索很久,终于有希望了,如何使用?我放在模块中,运行宏时,告知有几个变量未定义, 还有Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtendSub 人民币大写()为红字,望楼主指教!

1、我只是做了主模块，实际使用中可以把该宏定义到工具栏，这样会方便一些，具体步骤：工具→自定义→命令→宏→选定人民币大写宏→拖到工具栏； 使用中，首先选定要转换的数字，再执行此宏即可； 2、Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtendSub ，Selection.Delete两句是把转换的中间结果删除； 3、红字问题可以把Zx = Int(Val(Seltxt))改为Zx = abs(Int(Val(Seltxt)))，即取绝对值，然后再加一句Selcase="红书"，再把Selcase = Ym.Result + "元"句改为Selcase =Selcase+ Ym.Result + "元"。 该解决方法是一种思路，理解了其中的方法后，可以改成你实际中应用的情况，即转换后金额可任意放在你想放的地方。

hlrong

刚才看了看以前matsumi兄发的关于这方面的贴，我的代码也是利用了域，但微软好象不需要角分，所以只好分两步走了；功能是实现了，但要保持更新还没试过，不知把此宏指定给域行不行，请大家探讨。

matsumi

谢谢hlrong ！我会继续试一试，也会关注这方面课题。不带角分，大写很容易解决的，再一个是数字与大写如何能保持着链接，大写能随数字改变而改变，这在excel中已经解决了，在word中，到目前我还没看到，望兄弟努力解决一下！另外在word中文字或数字的链接是没有大问题的，也能及时刷新。

hlrong

二次修订，增加了红书情况和只有角分的情况判断： Sub 人民币大写()
Dim seltxt As String
Dim zx As Double, xx As Double
Dim selcase As String

seltxt = Selection.Text
zx = Int(Val(seltxt))
If zx < 0 Then
zx = Abs(Int(Val(seltxt)))
selcase = "红书"
Else
selcase = ""
End If
xx = (Round(Val(seltxt), 2) - zx) * 100
Selection.MoveRight Unit:=wdCharacter, Count:=1
If zx <> 0 Then
gxs = "= " + Str(zx) + " \* CHINESENUM2"
Set ym = Selection.Fields.Add(Range:=Selection.Range, Text:=gxs)
selcase = selcase + ym.Result + "元"
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.TypeBackspace
Selection.Delete
End If
gxs = "= " + Str(xx) + " \* CHINESENUM2"
Set ym = Selection.Fields.Add(Range:=Selection.Range, Text:=gxs)
xxcase = ym.Result
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.TypeBackspace
Selection.Delete Select Case xx
Case 0
selcase = selcase + "整"
Case 1 To 9
selcase = selcase + "零" + xxcase + "分"
Case 10 To 99
If (xx Mod 10) = 0 Then
selcase = selcase + Left(xxcase, 1) + "角整"
Else
selcase = selcase + Left(xxcase, 1) + "角" + Right(xxcase, 1) + "分"
End If
End Select
Selection.Text = selcase
End Sub

[此贴子已经被作者于2004-3-16 12:48:47编辑过]

skq

版主自称愚笨太谦虚了，佳作愚友看不懂，最好加上思路说明。

chengxiang

还是不行呀!对于负数，她将角和分舍去并进位到元。请楼主试试。她真的很实用。请修改一下好吗？谢谢!