ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[分享] Word 2003 VBA 自动排版宏(集成版)更新:2019-3-22

  [复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-3-31 23:32 | 显示全部楼层
我的《集成版》设置标题2345的时候,包含了处理标题 4 的形如:“1、XX”(顿号)、“1.XX”(小数点)和“1.XX”(齐线墨点)三种情况均设置为第 3 种,即形如“1.XX”,和处理标题4/5为全角数字为半角的小程序(其实在《公文》宏中已经将全文半角括号全部替换为全角括号),处理后,才能正确处理标题2345四种标题层次,这点请注意。

TA的精华主题

TA的得分主题

发表于 2019-4-1 12:13 来自手机 | 显示全部楼层
413191246se 发表于 2019-3-31 23:27
leedun 朋友,你好!——你的示例文本弄丢了形如“(一)XX”和“1.XX”这两种标题层次,我也不知道你是怎 ...

感谢前辈,回家测试,以前用您和杜先生的代码已经能满足要求,正是觉得集成代码设置标题代码快才想要用新方法,另外在另一帖子请教的like问题,like "#."只能匹配10以下的编号,10以上的不行,因为有时候标题样式是如下格式的,不知道用like怎么做到。
x.
x.x
x.x.x
x.x.x.x

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-4-2 00:13 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
  1. Sub test多级编号标题设置()
  2. '
  3. '编号后面的点,到底是小数点(1.1),还是齐线墨点(1.1)?我不清楚!有待商榷!
  4. '
  5. '多级编号设置参考 守柔版主 代码,倒着设置即可。
  6. '
  7. '其实用查找法也可以找到,暂时不考虑效率问题,用《循环遍历段落法》(For Each ... Next)是最简单的。
  8. '
  9. '请注意:只设置了样式,未设置过细的格式。标题2/3 均为 三号字,标题 4/5 均为 四号字
  10. '
  11. '既然提到 杜先生,我说一句:杜先生 去年前年为我编了好几个程序,我非常感谢他,也崇敬他!现在也是。
  12. '但是,杜先生 给我编程的《标题2345自动设置》宏,即 Title2345Auto 宏,是有错误的!在我测试过程中发现有时不能正确设置!
  13. '所以,我才抛开 杜先生 的正则表达式代码,自己用查找法设置标题2345;现在我已改为 ForEachNext 法,可以说是极快!
  14. '
  15.     With ActiveDocument
  16.         '自动编号转文本
  17.         .ConvertNumbersToText

  18.         '多级编号后添加半角空格(也可改为全角。再加一个空格即为全角)
  19.         With .Content.Find
  20.             .Execute "(^13[0-9.]{1,})", , , 1, , , , , , "\1 ", 2
  21.             .Execute "(^13[0-9.]{1,})([  ^s^t]{1,})", , , 1, , , , , , "\1 ", 2
  22.         End With

  23.         '核心代码(颜色设置只为鲜明,不喜欢可屏蔽/删除)----具体为标题几请自行修改,即 wdStyleHeading5(标题5)可改为 3
  24.         Dim i As Paragraph
  25.         For Each i In ActiveDocument.Paragraphs
  26.             With i.Range
  27.                 If .Text Like "#.#.#.#*" Then
  28.                     .Style = wdStyleHeading5
  29.                     .Font.Color = wdColorOrange
  30.                 ElseIf .Text Like "#.#.#*" Then
  31.                     .Style = wdStyleHeading4
  32.                     .Font.Color = wdColorGreen
  33.                 ElseIf .Text Like "#.#*" Then
  34.                     .Style = wdStyleHeading3
  35.                     .Font.Color = wdColorPink
  36.                 ElseIf .Text Like "#.*" Then
  37.                     .Style = wdStyleHeading2
  38.                     .Font.Color = wdColorRed
  39.                 End If
  40.             End With
  41.         Next
  42.     End With
  43. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2019-4-2 19:34 | 显示全部楼层

前辈好,以前在网上看过类似代码,对于内容少的编号能够排版,但是对于编号超过10的还是没法设置。
10.xx
10.11xx
10.11.22xxx
12.xx
12.36xx
12.36.22xx

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-4-2 21:19 | 显示全部楼层
leedun 你好!请试试下面代码:
  1. Sub test多级标题()
  2. '预处理
  3.     With ActiveDocument
  4.         '回车符/手动换行符=>段落标记
  5.         .Content.Find.Execute "[^13^11]", , , 1, , , , , , "^p", 2

  6.         '删除所有域
  7.         .Fields.Unlink

  8.         '自动编号转文本
  9.         .ConvertNumbersToText

  10.         '多级编号后添加半角空格
  11.         With .Content.Find
  12.             .Execute "(^13[0-9.]{1,})", , , 1, , , , , , "\1 ", 2
  13.             .Execute "(^13[0-9.]{1,})([  ^s^t]{1,})", , , 1, , , , , , "\1 ", 2
  14.         End With
  15.     End With

  16. '核心代码
  17.     Dim r As Range
  18.     With ActiveDocument.Content.Find
  19.         .ClearFormatting
  20.         .Text = "^13[0-9.]{1,}"
  21.         .Forward = True
  22.         .MatchWildcards = True
  23.         Do While .Execute
  24.             With .Parent
  25.                 .MoveStart
  26.                 Set r = .Paragraphs(1).Range
  27.                 If .Text Like "*.*.*.*" Then
  28.                     r.Style = wdStyleHeading5
  29.                     r.Font.Color = wdColorOrange
  30.                 ElseIf .Text Like "*.*.*" Then
  31.                     r.Style = wdStyleHeading4
  32.                     r.Font.Color = wdColorGreen
  33.                 ElseIf .Text Like "*.?*" Then
  34.                     r.Style = wdStyleHeading3
  35.                     r.Font.Color = wdColorPink
  36.                 ElseIf .Text Like "*." Then
  37.                     r.Style = wdStyleHeading2
  38.                     r.Font.Color = wdColorRed
  39.                 End If
  40.                 .Start = .End
  41.             End With
  42.         Loop
  43.     End With
  44. End Sub
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-4-3 19:34 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-4-4 18:57 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
leedun 发表于 2019-4-3 19:34
感谢前辈代码,明天测试一下

章节和多级代码已测试,非常感谢

TA的精华主题

TA的得分主题

发表于 2019-4-5 17:09 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-4-8 23:10 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-4-13 13:05 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
* 我这个《集成版》中有一个宏叫《人民币中文大写》,还有一个宏叫《千分位》,只要会用 VBA,就可以应用这两个宏解决全文查找“数字元”(例如:357.49元)的问题,有些朋友可能还不知道。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-7-14 15:32 , Processed in 0.037934 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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