|
楼主 |
发表于 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
复制代码 |
|