Word宏操作(表格序号填充、题注调整、表格环绕方式设置)

Working问题册 评论

脚本

表格序号填充

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub 表格序号填充()
'对于首列为序号列的表格进行遍历填充
Dim RowC As Integer
For Each tempTable In ActiveDocument.Tables
    With tempTable
        RowC = tempTable.Rows.Count
        .Cell(1, 1).Select
        If InStr(Selection.Text, "序号") <> 0 Then
            For i = 2 To RowC
                .Cell(i, 1).Select
                '手动编号1检测
                CK1 = Selection.Range.ListFormat.ListString = ""
                '自动编号1检测
                CK2 = Selection.Text = (Chr(13) & Chr(7))
                If CK1 And CK2 Then
                    Selection.Text = i - 1
                End If
            Next
        End If
    End With
Next tempTable
End Sub

全部表空白格填充

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub 全部表空白格填充()
Dim CK1, CK2 As Boolean
Dim aCell As Cell
For Each tempTable In ActiveDocument.Tables
    With tempTable
        For Each aCell In .Range.Cells
            aCell.Select
            CK1 = (Selection.Range.ListFormat.ListString = "")
            CK2 = (Selection.Text = (Chr(13) & Chr(7)))
            If CK1 And CK2 Then
                Selection.Text = "-"
            End If
        Next aCell
    End With
Next tempTable
End Sub

使用ListFormat.ListString和Selection.Text分别对手动填写和自动填充序号格式的内容进行判断

题注调整

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub 题注调整()
Dim CK1, CK2 As Boolean
For Each tempTable In ActiveDocument.Tables
    tempTable.Select
    Selection.MoveDown Count:=-1  '光标到前一行
    Selection.HomeKey '光标到行首
    Selection.EndKey Extend:=wdExtend '光标到行尾以选择当前行
    setParagraphStyle '设置段落字体格式
    Selection.ParagraphFormat.KeepWithNext = True ' 与下段同页
Next tempTable

'图片题注调整
For Each pic In ActiveDocument.InlineShapes
    pic.Select
    Selection.MoveDown Count:=1  '光标到前一行
    Selection.HomeKey '光标到行首
    Selection.EndKey Extend:=wdExtend '光标到行尾以选择当前行
    setParagraphStyle '设置段落字体格式
Next pic
End Sub

Sub setParagraphStyle()
    '字体设置
    With Selection.Font
        .Size = "10.5 " '设置内容字号5号
        .NameFarEast = "黑体" '中文黑体
        .NameAscii = "黑体" '非中文黑体
    End With
    
    '段落设置
    With Selection.ParagraphFormat
        .Alignment = wdAlignParagraphCenter '居中
        
        .CharacterUnitFirstLineIndent = 0 '首行缩进转换为厘米
        .FirstLineIndent = CentimetersToPoints(0) '设置首行缩进0厘米
        
        .CharacterUnitLeftIndent = 0 '左侧缩进转换为厘米
        .LeftIndent = CentimetersToPoints(0) '设置左侧缩进为0厘米
        
        .CharacterUnitRightIndent = 0 '右侧缩进转换为厘米
        .RightIndent = CentimetersToPoints(0) '设置右侧缩进为0厘米
        
        .SpaceBeforeAuto = False '取消段前间距自动格式
        .LineUnitBefore = 0 '段前间距转换为磅
        .SpaceBefore = 0 '设置段前间距为0
        
        .SpaceAfterAuto = False '取消段后间距自动格式
        .LineUnitAfter = 0 '段后间距转换为磅
        .SpaceAfter = 0 '设置段后间距为0
        
        .LineSpacingRule = wdLineSpaceMutiple '设置多倍行距
        .LineSpacing = LinesToPoints(1.25) '设置1.25倍行距
    End With
End Sub

将可复用部分封装为新的执行过程并调用，简化代码量及逻辑

全部表格调整环绕方式

1
2
3
4
5
Sub 全部表格调整环绕方式()
For Each tempTable In ActiveDocument.Tables
    tempTable.Rows.WrapAroundText = False '环绕方式设置无
Next tempTable
End Sub

重复标题行等属性不生效时，可能是表格环绕方式属性设置不正确

枫与风