Word 2003 VBA 自动排版宏（集成版）更新：2019-3-22

xkqtdzj · 发表于 2019-4-20 08:49

本帖最后由 xkqtdzj 于 2019-4-20 09:30 编辑

413191246se您好,我把试用的文件发上来，请试试。调用标题排序就会丢行。关了标题排序就不丢行。
谢谢您请把使用正常的office2003发到我的邮箱：83939985@qq.com。重点怀疑是版本差异造成的。

44.rar (15.1 KB, 下载次数: 25)

413191246se · 发表于 2019-4-20 18:32

邮件已发，是否下载安装使用正常？

xkqtdzj · 发表于 2019-4-20 20:07

本帖最后由 xkqtdzj 于 2019-4-21 19:30 编辑

谢谢413191246se，已收到安装包。用老师的安装包安装后只要运行Title2345AutoNum测试结果还是出现丢标题2标题3丢行？晕了。以下是安装后的版本显示情况。

xiaobaoyezi · 发表于 2019-4-21 17:11

学习学习。。。。。。

413191246se · 发表于 2019-4-22 00:05

本帖最后由 413191246se 于 2019-4-22 09:13 编辑

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

xkqtdzj · 发表于 2019-4-22 13:30

413191246se 发表于 2019-4-22 00:05
xkqtdzj：请将《公文》宏和《普通》宏中的 Title2345AutoNum 宏屏蔽/注释（即在前面加一个小撇儿'号）即可 ...

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

413191246se · 发表于 2019-4-23 00:48

xkqtdzj 你好！——请在你的 Word 中录制一个宏，步骤如下：
* 插入菜单——数字——键入 1——数字类型：选择“一二三（简）”——确定。
*
以下是我的录制代码：你也如此录制一下，看看咱们两个的录制结果是否一样？（毛病就出在这句！）
Selection.Fields.Add Range:=Selection.Range, Text:="= 1 \* CHINESENUM3"

xkqtdzj · 发表于 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

xkqtdzj · 发表于 2019-4-23 10:56

本帖最后由 xkqtdzj 于 2019-4-23 11:37 编辑

xkqtdzj 发表于 2019-4-23 10:27
录制结果是一样的：Sub Macro1()
'
' Macro1 Macro

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

413191246se · 发表于 2019-4-23 14:18

xkqtdzj：我的上一版本，即《Word2003VBA通用模板宏（2019元旦版）》，当时使用2016或2019的翼虎朋友也有吃字现象（一、二、三等行消失），我给他重新用翻译法替换了使用 Chinesenum3 域的方法，虽然繁琐了些，但比人工校对编号还是好不少，请试试下面的两个宏（删除原 Title2345AutoNum 宏，复制下面两个宏），再试试《公文》宏：

Sub Title2345AutoNum()
Dim doc As Document, r As Range, i As Paragraph, b&, c&, d&, e&
Set doc = ActiveDocument
With Selection
.Expand 4
.EndKey 6, 1
Set r = .Range
End With
For Each i In r.Paragraphs
With i.Range
If Not .Information(12) Then
If .Style = "标题 1" Or .Text Like "[!^13]附件*" Or .Text Like "附件*" Then
b = 0: c = 0: d = 0: e = 0
ElseIf .Style = "标题 2" Then
c = 0: d = 0: e = 0
b = b + 1
With doc.Range(Start:=.Characters(1).Start, End:=.Characters(InStr(i.Range, "、")).End - 1)
.Text = b
.Select
Num2Chn
End With
ElseIf .Style = "标题 3" Then
d = 0: e = 0
c = c + 1
With doc.Range(Start:=.Characters(1).Start, End:=.Characters(InStr(i.Range, "）")).End - 1)
.Text = c
.Select
Num2Chn
.InsertBefore Text:="（"
End With
ElseIf .Style = "标题 4" Then
e = 0
d = d + 1
doc.Range(Start:=.Characters(1).Start, End:=.Characters(InStr(i.Range, "．")).End - 1).Text = d
ElseIf .Style = "标题 5" Then
e = e + 1
With doc.Range(Start:=.Characters(1).Start, End:=.Characters(InStr(i.Range, "）")).End - 1)
.Text = e
.InsertBefore Text:="（"
End With
End If
End If
End With
Next
End Sub
Sub Num2Chn()
Dim a, r As Range, v&, i&
a = Array("零", "一", "二", "三", "四", "五", "六", "七", "八", "九")
With Selection
Set r = .Range
v = Len(.Text)
If v > 3 Then Exit Sub
With r
For i = 1 To v
.Characters(i).Text = a(.Characters(i))
Next i
If .Next.Text = "零" Then .Next.Delete
If v = 2 Then
.InsertAfter Text:="十"
If .Characters(1).Text = "一" Then .Characters(1).Delete
ElseIf v = 3 Then
.Characters(1).InsertAfter Text:="百"
.InsertAfter Text:="十"
.Select
If .Text Like "*百零十" Then
If .Next Like "[一二三四五六七八九]" Then
.Characters.Last.Delete
Else
.Text = Replace(.Text, "零十", "")
End If
End If
End If
End With
End With
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[分享] Word 2003 VBA 自动排版宏（集成版）更新：2019-3-22