wore 排版问题--vba如何操作样式标题

474489459

鼓捣了好久，没有结果，只能在此求助于各位老师。主要是在每个标题前插入表格，同时计算标题序号、页码等数据。请看附件。

kingtau

我也是小白，正在学习VBA，尝试了一下，以我的功力，只能半自动动操作了。
我的测试环境：win10+word2016。
选中标题所在的行，执行这个代码：

1. Sub 插入表格()
   
2.     Selection.End = Selection.End - 1
   
3.     c = Selection.Text
   
4.     Selection.EndKey
   
5.     Selection.TypeParagraph
   
6.     Set myTable = ActiveDocument.Tables.Add(Selection.Range, 3, 2)
   
7.     With Selection.Tables(1)
   
8.         .Style = "网格型"
   
9.         .Cell(1, 1).Range.InsertAfter Text:="题目：" & c
   
10.         .Cell(2, 1).Range.InsertAfter Text:="修改日期：年月日"
    
11.         .Cell(3, 1).Range.InsertAfter Text:="生效日期：年月日"
    
12.         .Cell(1, 2).Range.InsertAfter Text:="文件号：阳光医疗集团-"
    
13.         .Cell(2, 2).Range.InsertAfter Text:="版本号："
    
14.         .Cell(3, 2).Range.InsertAfter Text:="页数："
    
15.                 .Cell(1, 2).Range.Select
    
16.                 Selection.EndKey
    
17.                 Selection.Fields.Add Selection.Range, -1, "seq a"
    
18.                 Selection.Fields.Update
    
19.         .Select
    
20.         .Range.Font.Name = "仿宋"
    
21.         .Range.Font.Size = 14
    
22.     End With
    
23. End Sub

复制代码

kingtau

利用两天的空闲时间做了改进，过程中学到不少新知识
看着写的代码，像是小学生写作文，记流水账
统计页数的事情再说吧，感觉好难，别影响来之不易的学习热情

1. Sub 插入表格()
   
2. Dim i As Paragraph
   
3.     For Each i In ActiveDocument.Paragraphs
   
4.         If Len(Trim(i.Range)) = 1 Then
   
5.             i.Range.Delete '删除空段
   
6.             ElseIf i.Range.Bold Then
   
7.             i.Range.Select
   
8.             Selection.ParagraphFormat.PageBreakBefore = True '将找到的标题设置段前分页
   
9.         End If
   
10.    Next
    
11. For Each i In ActiveDocument.Paragraphs
    
12.     If i.Range.Bold Then
    
13.         n = n + 1
    
14.         i.Range.Select
    
15.             With Selection
    
16.                 .End = .End - 1
    
17.                 c = .Text
    
18.                 .EndKey
    
19.                 .MoveRight
    
20.                 Set myTable = ActiveDocument.Tables.Add(.Range, 3, 2)
    
21.                     With .Tables(1)
    
22.                         .Style = "网格型"
    
23.                         .Cell(1, 1).Range.InsertAfter Text:="题目：" & c
    
24.                         .Cell(2, 1).Range.InsertAfter Text:="修改日期：年月日"
    
25.                         .Cell(3, 1).Range.InsertAfter Text:="生效日期：年月日"
    
26.                         .Cell(1, 2).Range.InsertAfter Text:="文件号：阳光医疗集团-" & n
    
27.                         .Cell(2, 2).Range.InsertAfter Text:="版本号："
    
28.                         .Cell(3, 2).Range.InsertAfter Text:="页数："
    
29.                         .Select
    
30.                         .Range.Font.Name = "仿宋"
    
31.                         .Range.Font.Size = 14
    
32.                         .Columns.AutoFit
    
33.                         .AutoFitBehavior (wdAutoFitWindow)
    
34.                     End With
    
35.             .Cells.VerticalAlignment = wdCellAlignVerticalCenter
    
36.             .Collapse wdCollapseEnd
    
37.         End With
    
38.      End If
    
39. Next
    
40. End Sub

复制代码

kingtau

继续研究的成果，我这里测试可以一键达到楼主的要求。测试环境：win10 64位+word2016
兼容性未经测试，不同的系统版本和word版本可能会报错。
老鸟们没空回复初级问题，菜鸟们自力更生

1. 这里的格式出了问题，代码在后面楼层

复制代码

474489459

kingtau 发表于 2019-11-21 16:07
利用两天的空闲时间做了改进，过程中学到不少新知识
看着写的代码，像是小学生写作文，记流水账
统计页数 ...

你不是小白了，非常感谢你！

474489459

474489459 发表于 2019-11-22 15:50
你不是小白了，非常感谢你！

如果我以"标题2"作为判断标准决定是否插入表格，又该怎么办呢？

474489459

474489459 发表于 2019-11-22 16:45
如果我以"标题2"作为判断标准决定是否插入表格，又该怎么办呢？

如果以样式“标题2”或“标题1”来判断插入表格，代码又怎么调整呢？我是小黑，专门提难题。

474489459

kingtau 发表于 2019-11-22 14:16
继续研究的成果，我这里测试可以一键达到楼主的要求。测试环境：win10 64位+word2016
兼容性未经测试，不 ...

你太厉害了，边页数也右以写进去了。

474489459

kingtau 发表于 2019-11-22 14:16
继续研究的成果，我这里测试可以一键达到楼主的要求。测试环境：win10 64位+word2016
兼容性未经测试，不 ...

不知道这样写有什么问题没有？
Sub 插入表格()
Dim i As Paragraph, myTable As Table
    For Each i In ActiveDocument.Paragraphs
        If Len(Trim(i.Range)) = 1 Then
            i.Range.Delete '删除空段
        ElseIf i.Style = "标题 2" Then n = n + 1
            i.Range.Select
            Selection.ParagraphFormat.PageBreakBefore = True '将找到的标题设置段前分页
            With Selection
                    .End = .End - 1
                    c = .Text
                    .EndKey
                    .MoveRight
                    Set myTable = ActiveDocument.Tables.Add(.Range, 3, 2)
                        With .Tables(1)
                            .Style = "网格型"
                            .Cell(1, 1).Range.InsertAfter Text:="题目：" & c
                            .Cell(2, 1).Range.InsertAfter Text:="修改日期：2019年9月1日"
                            .Cell(3, 1).Range.InsertAfter Text:="生效日期：2019年11月1日"
                            .Cell(1, 2).Range.InsertAfter Text:="文件号：阳光医疗集团-GK-" & n
                            .Cell(2, 2).Range.InsertAfter Text:="版本号：1.0"
                            .Cell(3, 2).Range.InsertAfter Text:="页数："
                            .Select
                            .Range.Font.Name = "仿宋"
                            .Range.Font.Size = 12
                            .Columns.AutoFit
                            .AutoFitBehavior (wdAutoFitWindow)
                        End With
                    .Cells.VerticalAlignment = wdCellAlignVerticalCenter
                    .Collapse wdCollapseEnd
            End With
        End If
    Next
j = ActiveDocument.Tables.Count
    For k = 1 To j
        With ActiveDocument
            If k = j Then
                Page = .Range.Information(4) - .Tables(k).Range.Information(3) + 1
                .Tables(k).Cell(3, 2).Range.InsertAfter Page
                Exit For
            End If
                Page = .Tables(k + 1).Range.Information(3) - .Tables(k).Range.Information(3)
                .Tables(k).Cell(3, 2).Range.InsertAfter Page
        End With
    Next
End Sub

kingtau

474489459 发表于 2019-11-22 18:27
如果以样式“标题2”或“标题1”来判断插入表格，代码又怎么调整呢？我是小黑，专门提难题。

经过反复修改，可以达到要求的。
新手发贴和回复需要审核，经常好几个小时审核才能通过。
修改条件注释里有。

1. Sub 插入表格3()
   
2. Dim i As Paragraph
   
3. Application.ScreenUpdating = False
   
4.     For Each i In ActiveDocument.Paragraphs
   
5.             If Len(Trim(i.Range)) = 1 Then
   
6.                 i.Range.Delete '删除空段
   
7.                 ElseIf i.Range.Style = ActiveDocument.Styles("标题 3") Then '定义条件请修改这里
   
8.                 n = n + 1
   
9.                 i.Range.Select
   
10.                 Selection.ParagraphFormat.PageBreakBefore = True '将找到的标题设置段前分页
    
11.                 With Selection
    
12.                     .End = .End - 1
    
13.                     c = .Text
    
14.                     .EndKey
    
15.                     .MoveRight
    
16.                     Set myTable = ActiveDocument.Tables.Add(.Range, 3, 2)
    
17.                         With .Tables(1)
    
18.                             .Style = "网格型"
    
19.                             .Cell(1, 1).Range.InsertAfter Text:="题目：" & c
    
20.                             .Cell(2, 1).Range.InsertAfter Text:="修改日期：年月日"
    
21.                             .Cell(3, 1).Range.InsertAfter Text:="生效日期：年月日"
    
22.                             .Cell(1, 2).Range.InsertAfter Text:="文件号：阳光医疗集团-" & n
    
23.                             .Cell(2, 2).Range.InsertAfter Text:="版本号："
    
24.                             .Cell(3, 2).Range.InsertAfter Text:="页数："
    
25.                             .Select
    
26.                             .Range.Font.Name = "仿宋"
    
27.                             .Range.Font.Size = 14
    
28.                             .Columns.AutoFit
    
29.                             .AutoFitBehavior (wdAutoFitWindow)
    
30.                         End With
    
31.                 .Cells.VerticalAlignment = wdCellAlignVerticalCenter
    
32.                 .Collapse wdCollapseEnd
    
33.             End With
    
34.      End If
    
35. Next
    
36. j = ActiveDocument.Tables.Count
    
37.     For k = 1 To j
    
38.         With ActiveDocument
    
39.             If k = j Then
    
40.                 page = .Range.Information(4) - .Tables(k).Range.Information(3) + 1
    
41.                 .Tables(k).Cell(3, 2).Range.InsertAfter page
    
42.                 Exit For
    
43.             End If
    
44.                 page = .Tables(k + 1).Range.Information(3) - .Tables(k).Range.Information(3)
    
45.                 .Tables(k).Cell(3, 2).Range.InsertAfter page
    
46.         End With
    
47.     Next
    
48. Application.ScreenUpdating = True
    
49. End Sub

复制代码