ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

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

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2019-4-20 08:49 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 xkqtdzj 于 2019-4-20 09:30 编辑

413191246se您好,我把试用的文件发上来,请试试。调用标题排序就会丢行。关了标题排序就不丢行。
谢谢您请把使用正常的office2003发到我的邮箱:83939985@qq.com。重点怀疑是版本差异造成的。 44.rar (15.1 KB, 下载次数: 25)

测试版本

测试版本

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-4-20 18:32 | 显示全部楼层
邮件已发,是否下载安装使用正常?

TA的精华主题

TA的得分主题

发表于 2019-4-20 20:07 来自手机 | 显示全部楼层
本帖最后由 xkqtdzj 于 2019-4-21 19:30 编辑

谢谢413191246se,已收到安装包。用老师的安装包安装后只要运行Title2345AutoNum测试结果还是出现丢标题2标题3丢行?晕了。以下是安装后的版本显示情况。
2019-04-21_191842.png

TA的精华主题

TA的得分主题

发表于 2019-4-21 17:11 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-4-22 00:05 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 413191246se 于 2019-4-22 09:13 编辑

xkqtdzj:请将《公文》宏和《普通》宏中的 Title2345AutoNum 宏屏蔽/注释(即在前面加一个小撇儿'号)即可,此宏功能是将标题2345自动排序。取消此宏后,标题2345必须人工校对排序了!看看是否排版正确。——建议:在未屏蔽 Title2345AutoNum 宏之前,看看出错时出在哪条语句?请告诉我一下。
——如果最终还是不行,那么请思考一下:你是否必须经常要用到 Word 呢?如果是几乎每天都要用到 Word2003 来工作的话,我建议你可以安装 Win7(32位版),但不请不必着急安装32位版,再看看(缓行);我在单位就是用 32位的 Win7 + Word2003,家里XP+Word2003,什么毛病也没有。

TA的精华主题

TA的得分主题

发表于 2019-4-22 13:30 | 显示全部楼层
413191246se 发表于 2019-4-22 00:05
xkqtdzj:请将《公文》宏和《普通》宏中的 Title2345AutoNum 宏屏蔽/注释(即在前面加一个小撇儿'号)即可 ...

调试过程录屏文件发到您邮箱。请帮忙看看。谢谢!

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-4-23 00:48 | 显示全部楼层
xkqtdzj 你好!——请在你的 Word 中录制一个宏,步骤如下:
* 插入菜单——数字——键入 1——数字类型:选择“一 二 三(简)”——确定。
*
以下是我的录制代码:你也如此录制一下,看看咱们两个的录制结果是否一样?(毛病就出在这句!)
Selection.Fields.Add Range:=Selection.Range, Text:="= 1 \* CHINESENUM3"

TA的精华主题

TA的得分主题

发表于 2019-4-23 10:27 | 显示全部楼层
413191246se 发表于 2019-4-23 00:48
xkqtdzj 你好!——请在你的 Word 中录制一个宏,步骤如下:
* 插入菜单——数字——键入 1——数字类型: ...

录制结果是一样的:Sub Macro1()
'
' Macro1 Macro
' 宏在 2019-04-23 由 xkq 录制
'
    Selection.Fields.Add Range:=Selection.Range, Text:="= 1 \* CHINESENUM3"
End Sub

TA的精华主题

TA的得分主题

发表于 2019-4-23 10:56 | 显示全部楼层
本帖最后由 xkqtdzj 于 2019-4-23 11:37 编辑
xkqtdzj 发表于 2019-4-23 10:27
录制结果是一样的:Sub Macro1()
'
' Macro1 Macro

试着传一张图,看能不能显示。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-4-23 14:18 | 显示全部楼层
xkqtdzj:我的上一版本,即《Word2003VBA通用模板宏(2019元旦版)》,当时使用2016或2019的 翼虎 朋友 也有吃字现象(一、二、三等行消失),我给他重新用翻译法替换了使用 Chinesenum3 域的方法,虽然繁琐了些,但比人工校对编号还是好不少,请试试下面的两个宏(删除原 Title2345AutoNum 宏,复制下面两个宏),再试试《公文》宏:
  1. Sub Title2345AutoNum()
  2.     Dim doc As Document, r As Range, i As Paragraph, b&, c&, d&, e&
  3.     Set doc = ActiveDocument
  4.     With Selection
  5.         .Expand 4
  6.         .EndKey 6, 1
  7.         Set r = .Range
  8.     End With
  9.     For Each i In r.Paragraphs
  10.         With i.Range
  11.             If Not .Information(12) Then
  12.                 If .Style = "标题 1" Or .Text Like "[!^13]附件*" Or .Text Like "附件*" Then
  13.                     b = 0: c = 0: d = 0: e = 0
  14.                 ElseIf .Style = "标题 2" Then
  15.                     c = 0: d = 0: e = 0
  16.                     b = b + 1
  17.                     With doc.Range(Start:=.Characters(1).Start, End:=.Characters(InStr(i.Range, "、")).End - 1)
  18.                         .Text = b
  19.                         .Select
  20.                         Num2Chn
  21.                     End With
  22.                 ElseIf .Style = "标题 3" Then
  23.                     d = 0: e = 0
  24.                     c = c + 1
  25.                     With doc.Range(Start:=.Characters(1).Start, End:=.Characters(InStr(i.Range, ")")).End - 1)
  26.                         .Text = c
  27.                         .Select
  28.                         Num2Chn
  29.                         .InsertBefore Text:="("
  30.                     End With
  31.                 ElseIf .Style = "标题 4" Then
  32.                     e = 0
  33.                     d = d + 1
  34.                     doc.Range(Start:=.Characters(1).Start, End:=.Characters(InStr(i.Range, ".")).End - 1).Text = d
  35.                 ElseIf .Style = "标题 5" Then
  36.                     e = e + 1
  37.                     With doc.Range(Start:=.Characters(1).Start, End:=.Characters(InStr(i.Range, ")")).End - 1)
  38.                         .Text = e
  39.                         .InsertBefore Text:="("
  40.                     End With
  41.                 End If
  42.             End If
  43.         End With
  44.     Next
  45. End Sub
  46. Sub Num2Chn()
  47.     Dim a, r As Range, v&, i&
  48.     a = Array("零", "一", "二", "三", "四", "五", "六", "七", "八", "九")
  49.     With Selection
  50.         Set r = .Range
  51.         v = Len(.Text)
  52.         If v > 3 Then Exit Sub
  53.         With r
  54.             For i = 1 To v
  55.                 .Characters(i).Text = a(.Characters(i))
  56.             Next i
  57.             If .Next.Text = "零" Then .Next.Delete
  58.             If v = 2 Then
  59.                 .InsertAfter Text:="十"
  60.                 If .Characters(1).Text = "一" Then .Characters(1).Delete
  61.             ElseIf v = 3 Then
  62.                 .Characters(1).InsertAfter Text:="百"
  63.                 .InsertAfter Text:="十"
  64.                 .Select
  65.                 If .Text Like "*百零十" Then
  66.                     If .Next Like "[一二三四五六七八九]" Then
  67.                         .Characters.Last.Delete
  68.                     Else
  69.                         .Text = Replace(.Text, "零十", "")
  70.                     End If
  71.                 End If
  72.             End If
  73.         End With
  74.     End With
  75. End Sub
复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-12-14 04:52 , Processed in 0.050758 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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