杜先生 请进：选定区域《公文标题连续编号》

413191246se

杜先生 好！
——本来想今天发布我的通用模板宏，但又发现《附件》等宏有些小毛病，发布只好中止。
——现在工作中经常排版别人的文档，常常前面是2、3页通知正文，后面是附件（多数是表格）。
——现在我想一改以前的排版思路，不排版全文，只排版前3页（假设前3页是通知正文），第4页以后不排版（尽量保持原样不变）。
——现在想求 杜先生 再费一点精力，请在《公文标题连续编号》宏的基础上，修改一下，在选定区域内使公文标题连续编号（仅排版表格外段落），但未选定区域保持不变。
——下面是例文，请选定星号（***）上面所有文字，在选定区域使公文标题连续编号，谢谢 杜先生！
——（例文中间杂表格，但贴不上来）
选定区域《公文标题连续编号》
十六、指导3456思想
（二十一）全面落实创先争优工作
14、标本兼治
5．综合治理
（四）联系实际，突出重点
28.完善民主生活会制度
（5）艰苦奋斗，不奢侈浪费
（4）公道正派
九、工作实践
七十八、今后改进
********************************************
六十、政府5634报告
（十二）认真细致耐心
47.丰富多彩
25．锲而不舍
（四十）改革开放
72、高等教育
（54）教育教学
（41）马克思主义
八十七、扶贫工作

duquancai

没空写具体代码，提示：新建多级列表样式并运用该样式。

413191246se

杜先生：——代码不必写了！我想到两点：
——1、不创建多级列表样式，用变量计数累加赋值给标题编号的方法也能达到目的，可能繁琐些；
——2、选区排版：我突然想到一个妙法，那就是，光标定位于不想排版区域前面，然后剪切到剪贴板，进行全文排版，然后再粘回来。
下面是录制宏代码：（很简单，我认为不错！可行！）
*
Sub 选区自动排版()
    Selection.EndKey Unit:=wdStory, Extend:=wdExtend '向后选定不排版区域
    Selection.Cut '剪切到剪贴板
    公文 '全文自动排版（表格除外）
    Selection.EndKey Unit:=wdStory '光标至文尾
    Selection.Paste '粘贴
    ActiveDocument.Characters(1).Copy '复制字符1(变相清空剪贴板)
End Sub

413191246se

杜先生：请不必写代码了，即使有时间。因为把不排版区域临时剪切到剪贴板，排版完毕，再粘贴回来，这个方法很简单、巧妙。——而且，我现在感觉我的很多宏，似乎都没用，根本用不上，现在就是公文排版最急用，其实我想来最少代码保存在 Normal.dot 中，多了感觉模板不稳定。——谢谢啊！

duquancai

413191246se 发表于 2017-6-2 09:00
杜先生：请不必写代码了，即使有时间。因为把不排版区域临时剪切到剪贴板，排版完毕，再粘贴回来，这个方法 ...

Sub 多级列表样式运用()
    Dim p As Range, doc As Document, s As Range
    Set doc = ActiveDocument
    Set p = IIf(Selection.Type = wdSelectionIP, doc.Content, Selection.Range)
    If p = doc.Content Then
        k = MsgBox("要进行全文处理吗？", vbYesNoCancel + vbQuestion, "全文处理判断")
        If k <> vbYes Then Exit Sub
    End If
    With p.Find
        .Execute "^11", , , 1, , , , 0, , "^p", 2
        .Execute "^p^w", , , 0, , , , 0, , "^p", 2
        .Execute "^w^p", , , 0, , , , 0, , "^p", 2
    End With
    sr$ = "〇一二三四五六七八九十百千万亿"
    r1$ = "[" & sr & "]@、": r2$ = "[(（][" & sr & "]@[)）]"
    r3$ = "[0-9]@[、.．]": r4$ = "[(（][0-9]@[)）]"
    a = Array(r1, r2, r3, r4)
    Call ListTitle(doc)
    For j = 0 To UBound(a)
        Set s = p.Duplicate
        With s.Find
            Do While .Execute(a(j), , , 1)
                If Not s.InRange(p) Then Exit Do
                With .Parent
                    If Not .Information(wdWithInTable) Then
                        x = Len(.Text): ksr = .Text
                        .Expand 4: .Collapse
                        If .MoveWhile(ksr, x) = x Then
                            .MoveStart , -x: .Text = Empty
                            .Style = ActiveDocument.Styles("s" & j + 2)
                        Else
                            .Move 4, 1
                        End If
                    End If
                End With
            Loop
        End With
    Next
    p.ListFormat.ConvertNumbersToText
End Sub
Sub ListTitle(doc As Document)
    Dim LtTemp As ListTemplate, i As Integer
    Set LtTemp = doc.ListTemplates.Add(True)
    On Error Resume Next
    doc.Styles.Add Name:="s2", Type:=1
    doc.Styles.Add Name:="s3", Type:=1
    doc.Styles.Add Name:="s4", Type:=1
    doc.Styles.Add Name:="s5", Type:=1
    a = Array(6, 5, 2, 11)
    For i = 2 To 5
        With LtTemp.ListLevels(i)
            If i = 2 Then .NumberFormat = "%2、": .NumberStyle = 37
            If i = 3 Then .NumberFormat = "（%3）": .NumberStyle = 37
            If i = 4 Then .NumberFormat = "%4.": .NumberStyle = 0
            If i = 5 Then .NumberFormat = "（%5）": .NumberStyle = 0
            .TrailingCharacter = 2: .StartAt = 1: .ResetOnHigher = True
            .NumberPosition = InchesToPoints(0.1 * (i - 1))
            .TextPosition = InchesToPoints(0 * i)
            .LinkedStyle = "s" & i
            doc.Styles("s" & i).Font.ColorIndex = a(i - 2)
        End With
    Next
End Sub

413191246se

杜先生 辛苦了！多谢！
——看来，杜先生 写了代码，是有时间了，也许，是勉为其难地为我专程写的代码……
——代码测试 OK！但今天它和以前的不一样了，不直接设置标题样式，而是普通正文了；当然这也没啥，我现在用《循环遍历段落法》或《Do...Loop 查找法》也能设置标题样式，Range算法比Selection快，最终还是 杜先生 的《正则表达式》最快。
——今天我重点学了好久的 杜先生 的《查找和替换》的简写方法，前面 3 个逗号，后面 6 个逗号，但今天 杜先生 的代码中 又多了一个 0；通配符 这项，我发现它不能用逗号代替，非0即1，以后我也这样简写替换语句了……
——目前我也经常双面打印，所以，有时页码不是外侧就是内侧，我想做一个插入页码时的切换按钮，但《切换页码外侧内侧》搞不定，请 杜先生 指导一下，下面是我录制的宏：
************************
Sub 切换页码外侧内侧()
'第一次按此宏按钮，是：插入页码-外侧；再按一次此宏按钮，是：插入页码-内侧；反复切换。
    Selection.Sections(1).Footers(1).PageNumbers.Add PageNumberAlignment:=wdAlignPageNumberOutside, FirstPage:=False
    Selection.Sections(1).Footers(1).PageNumbers.Add PageNumberAlignment:=wdAlignPageNumberInside, FirstPage:=False
End Sub
******************** 杜先生 我还有一件小事：我想得到一个“假回车符”(^13)的符号，以方便在文档中测试替换为真正的 ^p，可是却不清楚怎么找出来这个“假回车符”（特点是：光标可在弯勾的后面；真回车符光标只能在弯勾前），过去遇到过，但文本已经没有保存，网上也许有，但不知道到哪里去找，杜先生 如果知道怎么打出来，请告诉我方法。

duquancai

413191246se 发表于 2017-6-2 22:42
杜先生 辛苦了！多谢！
——看来，杜先生 写了代码，是有时间了，也许，是勉为其难地为我专程写的代码…… ...

勾选使用通配符     查找  ^13    替换   ^13^10

413191246se

——杜先生，不好意思！
——我思来想去，多级列表不是我所需，我只需要“标题2/3/4/5”样式，请 杜先生 再辛苦一下，把 s2/3/4/5 改为“标题 2/3/4/5”的样式，这样就完美了！（我试着修改，结果不行。另个人偏好：标题2红色，标题3粉红，标题4绿色，标题5橙色，正文蓝色，杜先生 这个橙色不知颜色序号ColorIndex是多少？）
——下面是前几天的《公文标题连续编号》宏的几句代码，请 杜先生 借鉴一下：
b = Array("标题 2", "标题 3", "标题 4", "标题 5")
.LinkedStyle = "标题 " & i
doc.Styles("标题 " & i).Font.ColorIndex = a(i - 2)

413191246se

好用！一下子捉到 25只 假回车 ！ 谢谢！我以为打出它很难，没想到这么简单！

413191246se

杜先生：代码不用改了！选区标题连续编号，已经达到目的，虽然是普通正文格式也很好的；至于设置标题样式，我是轻车熟路了，用选区循环遍历段落法即可（i.range），我只需要加个提醒即可。——这次的代码能够将段落首尾空格删除（^p^w,^w^p，这个^w空白区域，我也知道，以前我用居中/两端对齐，以后就用替换了），以前的都没办到，可能是《区分全半角》这个选项关闭的缘故。