VBA如何实现标题级别的自动设置

bertoni

参考了http://club.excelhome.net/thread-659228-1-1.html 这个帖子，自己写了一个宏，作用是1. 将全文的大纲级别设置为正文
2. 自动设置以“第X节”开头的标题为居中、大纲级别1级，“X、”开头的标题为居左，大纲级别2级，代码如下：

1. Sub 运行此宏设置二级标题格式()
   
2.       Call 全文更改为正文
   
3.       Call 循环查找一级标题并替换
   
4.       Call 循环查找二级标题并替换
   
5. End Sub
   
6. Sub 全文更改为正文()
   
7. '
   
8. '
   
9. '
   
10.     Selection.WholeStory
    
11.     With Selection.ParagraphFormat
    
12.         .SpaceBeforeAuto = False
    
13.         .SpaceAfterAuto = False
    
14.         .OutlineLevel = wdOutlineLevelBodyText
    
15.         .WordWrap = True
    
16.     End With
    
17. End Sub
    
18. 
    
19. Sub 循环查找一级标题并替换()
    
20. Dim I As Integer '循环执行
    
21. For I = 1 To 100 '假设有100个，循环执行100次
    
22.     Selection.Find.ClearFormatting
    
23.     Selection.Find.Replacement.ClearFormatting
    
24.     With Selection.Find
    
25.         .Text = "(^13第[一二三四五六七八九十]{1,}节)(*^13)"
    
26.         .Replacement.Text = ""
    
27.         .Forward = True
    
28.         .Wrap = wdFindContinue
    
29.         .Format = False
    
30.         .MatchCase = False
    
31.         .MatchWholeWord = False
    
32.         .MatchByte = False
    
33.         .MatchAllWordForms = False
    
34.         .MatchSoundsLike = False
    
35.         .MatchWildcards = True
    
36.     End With
    
37.     Selection.Find.Execute ' 设置字体字号 Macro
    
38.     Selection.Font.Name = "仿宋" '字体
    
39.     Selection.Font.Bold = True '加粗
    
40.     Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    
41.     Selection.Font.Size = 16 '字号，14=四号；16=三号……
    
42.     Selection.ParagraphFormat.OutlineLevel = wdOutlineLevel1
    
43. Next I
    
44. End Sub
    
45. 
    
46. Sub 循环查找二级标题并替换()
    
47. Dim I As Integer '循环执行
    
48. For I = 1 To 100 '假设有100个，循环执行100次
    
49.     ' 查找一二三顿号开头的段落
    
50.     Selection.Find.ClearFormatting
    
51.     Selection.Find.Replacement.ClearFormatting
    
52.     With Selection.Find
    
53.         .Text = "(^13[一二三四五六七八九十]{1,}、)(*^13)"
    
54.         .Replacement.Text = ""
    
55.         .Forward = True
    
56.         .Wrap = wdFindContinue
    
57.         .Format = False
    
58.         .MatchCase = False
    
59.         .MatchWholeWord = False
    
60.         .MatchByte = False
    
61.         .MatchAllWordForms = False
    
62.         .MatchSoundsLike = False
    
63.         .MatchWildcards = True
    
64.     End With
    
65.     Selection.Find.Execute ' 设置字体字号 Macro
    
66.     Selection.Font.Name = "仿宋" '字体
    
67.     Selection.Font.Bold = True '加粗
    
68.     Selection.Font.Size = 14 '字号，14=四号；16=三号……
    
69.     Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    
70.     Selection.ParagraphFormat.OutlineLevel = wdOutlineLevel2
    
71. Next I
    
72. End Sub
    

复制代码

目前碰到两个问题：1. 对“第X节”开头的标题无效，点击不作任何更改
2. 对“X、”开头的行，会自动设置该行和其上的一个段落为大纲二级

请各位大神指教

413191246se

楼主，我有 Word2003 通用模板（扩展宏）帖子，你可以在本论坛搜索一下，对标题1、2、3、4、5均有自动设置，我自我感觉不错。

bertoni

413191246se 发表于 2015-12-10 16:20
楼主，我有 Word2003 通用模板（扩展宏）帖子，你可以在本论坛搜索一下，对标题1、2、3、4、5均有自动设置 ...

高手啊，谢谢指教

chenwenming

我用了个笨办法，解决了文档第一行就是标题行的设置，不知有没有更好的办法

Sub 循环查找一级标题并替换()
Dim I As Integer '循环执行
For I = 1 To 100 '假设有100个，循环执行100次
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
   If I = 1 Then
   With Selection.Find
        .Text = "(第[一二三四五六七八九十]{1,}章)(*^13)"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute ' 设置字体字号 Macro
    Selection.Font.Name = "仿宋" '字体
    Selection.Font.Bold = True '加粗
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.Font.Size = 16 '字号，14=四号；16=三号……
    Selection.ParagraphFormat.OutlineLevel = wdOutlineLevel1
    Else
    With Selection.Find
        .Text = "(^13第[二三四五六七八九十]{1,}章)(*^13)"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute ' 设置字体字号 Macro
    Selection.Font.Name = "仿宋" '字体
    Selection.Font.Bold = True '加粗
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.Font.Size = 16 '字号，14=四号；16=三号……
    Selection.ParagraphFormat.OutlineLevel = wdOutlineLevel1
    End If
Next I
End Sub

飞驰的椒麻鸡

踩踩踩踩踩踩踩踩踩踩踩踩踩

snow653124

第二种方法
只适用于特定目录格式的排版，如果换一个就不行了。
这个其实我也有需求，我想找那种他搜索到这个几级目录的自动变换，但是好像不行，不知道哪里出了问题。