ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
12
返回列表 发新帖
楼主: muziligao

[求助] WORD中如何用域代码转换人民币大写

[复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-5-27 14:14 | 显示全部楼层
413191246se 发表于 2019-5-27 14:07
楼主,我重新下载后附件又损坏了,也许我的电脑中有病毒木马?请将WORD 内容粘贴到帖子中即可,让我看看你 ...

谢谢你,真是有心了。黄色部份就是数据源的数据
邮件合并文档.jpg
数据源.jpg

TA的精华主题

TA的得分主题

发表于 2019-5-29 00:19 | 显示全部楼层
楼主,你的中标通知书中只有一处金额,手动就 OK 了,何必要用 VBA 呢?你想打开标书就自动转换,但我建议还是要检查一下看看有没有错误再打印才好。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-5-29 10:17 | 显示全部楼层
413191246se 发表于 2019-5-29 00:19
楼主,你的中标通知书中只有一处金额,手动就 OK 了,何必要用 VBA 呢?你想打开标书就自动转换,但我建议 ...

是不想用vba。问题是,数据源金额是小写。中标通知书里需要先大写,再括号小写。大写我想自动实现。不需要人工去写。用网上说的那个域开关,只能实现100万以内的金额自动大写。当金额大于100万时,就提示错误了。

TA的精华主题

TA的得分主题

发表于 2019-5-29 17:24 | 显示全部楼层
* 楼主,请试用下面的宏,但建议还是检查大写金额无误后再存盘,以免造成经济损失,谢谢!
  1. Sub AutoOpen()

  2. '原名:人民币中文大写

  3. '功能:全文查找数字元/大写在前c=1/大写在后c=0

  4.     Const s As String = "万仟佰拾亿仟佰拾万仟佰拾元角分"

  5.     Dim c&, i$, j&, a$, n&

  6.     c = 1

  7.     With ActiveDocument.Content.Find
  8.         .ClearFormatting
  9.         .Text = "[0-9.  ^s^t,,]{1,}元"
  10.         .Forward = True
  11.         .MatchWildcards = True
  12.         Do While .Execute
  13.             With .Parent
  14.                 .MoveEnd 1, -1

  15.                 i = .Text

  16.                 i = Replace(i, " ", "")
  17.                 i = Replace(i, " ", "")
  18.                 i = Replace(i, vbTab, "")
  19.                 i = Replace(i, ChrW(160), "")
  20.                 i = Replace(i, ",", "")
  21.                 i = Replace(i, ",", "")

  22.                 If i Like "*.*.*" Then .Font.Color = wdColorRed: GoTo sk

  23.                 i = Format(i, "Standard")
  24.                 i = Replace(i, ",", "")
  25.                 i = Replace(i, ".", "")

  26.                 j = Len(i)

  27.                 If j > 15 Then GoTo sk

  28.                 a = ""

  29.                 For n = 1 To j
  30.                     a = a & Mid(i, n, 1) & Mid(s, 15 - j + n, 1)
  31.                 Next n

  32.                 a = Replace(a, "1", "壹")
  33.                 a = Replace(a, "2", "贰")
  34.                 a = Replace(a, "3", "叁")
  35.                 a = Replace(a, "4", "肆")
  36.                 a = Replace(a, "5", "伍")
  37.                 a = Replace(a, "6", "陆")
  38.                 a = Replace(a, "7", "柒")
  39.                 a = Replace(a, "8", "捌")
  40.                 a = Replace(a, "9", "玖")
  41.                 a = Replace(a, "0", "零")
  42. '''
  43.                 a = Replace(a, "零仟", "零")
  44.                 a = Replace(a, "零佰", "零")
  45.                 a = Replace(a, "零拾", "零")

  46.                 Do While a Like "*零零*"
  47.                     a = Replace(a, "零零", "零")
  48.                 Loop

  49.                 a = Replace(a, "零亿", "亿零")
  50.                 a = Replace(a, "零万", "万零")
  51.                 a = Replace(a, "零元", "元零")

  52.                 Do While a Like "*零零*"
  53.                     a = Replace(a, "零零", "零")
  54.                 Loop

  55.                 a = Replace(a, "零角零分", "整")
  56.                 a = Replace(a, "零角", "零")
  57.                 a = Replace(a, "零分", "")

  58.                 If a Like "元零*" Then a = Replace(a, "元零", "")
  59.                 If a = "元整" Then a = "零" & a

  60.                 If a Like "*万零元*" And Val(a) < 100000000 Then a = Replace(a, "万零元", "万元") '10万<=X<1亿
  61.                 a = Replace(a, "亿万", "亿")

  62.                 If a Like "*亿零万*" Then a = Replace(a, "零万", "") '>=10亿
  63. '''
  64.                 If c = 1 Then
  65.                     .Select
  66.                     .MoveStart 1, -2
  67.                     .Select
  68.                     .InsertBefore Text:="人民币" & a
  69.                 Else
  70.                     .MoveEnd
  71.                     .InsertAfter Text:="(人民币" & a & ")"
  72.                 End If
  73. sk:
  74.                 .Start = .End
  75.             End With
  76.         Loop
  77.     End With
  78.     Selection.HomeKey Unit:=wdStory
  79. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2020-10-10 16:47 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-12-27 20:32 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
进来学习!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2025-1-9 15:08 , Processed in 0.021737 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表