i多表处理

i多表处理

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
Sub 多表_一键调整(control As IRibbonControl) '批量调整表格格式
    Application.ScreenUpdating = False  '关闭屏幕刷新
    Application.DisplayAlerts = False  '关闭提示
    On Error Resume Next  '忽略错误
    '-------------------------------------------------------------------------
    Dim mytable As Table, i As Long
    For Each mytable In ActiveDocument.Tables
        With mytable
            .Shading.ForegroundPatternColor = wdColorAutomatic
            .Shading.BackgroundPatternColor = wdColorAutomatic
            Options.DefaultHighlightColorIndex = wdNoHighlight
            .Range.HighlightColorIndex = wdNoHighlight
            .Style = "表格主题"
            With .Borders(wdBorderLeft)
                .LineStyle = wdLineStyleSingle: .LineWidth = wdLineWidth150pt
            End With
            With .Borders(wdBorderRight)
                .LineStyle = wdLineStyleSingle: .LineWidth = wdLineWidth150pt
            End With
            With .Borders(wdBorderTop)
                .LineStyle = wdLineStyleSingle: .LineWidth = wdLineWidth150pt
            End With
            With .Borders(wdBorderBottom)
                .LineStyle = wdLineStyleSingle: .LineWidth = wdLineWidth150pt
            End With
            With .Borders(wdBorderVertical)
                .LineStyle = wdLineStyleSingle: .LineWidth = wdLineWidth050pt
            End With
            .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
            .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
            '单元格边距
            .TopPadding = CentimetersToPoints(0) '设置上边距为0
            .BottomPadding = CentimetersToPoints(0) '设置下边距为0
            .LeftPadding = PixelsToPoints(0, True)  '设置左边距为0
            .RightPadding = PixelsToPoints(0, True) '设置右边距为0
            .Spacing = PixelsToPoints(0, True) '允许单元格间距为0
            .AllowPageBreaks = True '允许断页
            '.AllowAutoFit = True '允许自动重调尺寸
            With .Rows
                .WrapAroundText = False '取消文字环绕
                '.Alignment = wdAlignRowCenter '表水平居中  wdAlignRowLeft '左对齐
                .AllowBreakAcrossPages = False '不允许行断页
                .Height = CentimetersToPoints(0.8) '行高0.8
                .HeightRule = wdRowHeightAtLeast '行高设为最小值
                .LeftIndent = CentimetersToPoints(0) '左面缩进量为0
            End With
            With .Range
                With .Font '字体格式
                    .NameFarEast = "宋体"
                    .NameAscii = "Times New Roman"
                    .NameOther = "Times New Roman"
                    .Color = wdColorAutomatic '自动字体颜色
                    .Size = 10.5   '字号
                    .Kerning = 0
                    .DisableCharacterSpaceGrid = True  '选定段落中的字符与行网格对齐
                End With
                With .ParagraphFormat '段落格式
                    .LineUnitBefore = 0
                    .LineUnitAfter = 0
                    .SpaceBefore = 0
                    .SpaceAfter = 0
                    .CharacterUnitFirstLineIndent = 0 '取消首行缩进
                    .FirstLineIndent = CentimetersToPoints(0) '取消首行缩进
                    .LineSpacingRule = wdLineSpaceSingle 'wdLineSpaceSingle '单倍行距  wdLineSpaceExactly '行距固定值
                    ''.LineSpacing = 18 '设置行间距为18磅，配合行距固定值
                    '.Alignment = wdAlignParagraphCenter '单元格水平居中
                    .AutoAdjustRightIndent = False  '自动调整所选段落的右缩进
                    .DisableLineHeightGrid = True   '选定段落中的字符与行网格对齐
                End With
                .Cells.VerticalAlignment = wdCellAlignVerticalCenter  '单元格垂直居中
            End With
            For Each cl In .Range.Cells    '文字靠左，数字靠右
                Acell = ActiveDocument.Range(cl.Range.Start, cl.Range.End - 1).Text '提取文本
                If IsNumeric(Acell) Then
                    cl.Range.ParagraphFormat.Alignment = wdAlignParagraphRight    '右对齐
                Else
                    cl.Range.ParagraphFormat.Alignment = wdAlignParagraphJustify   '左对齐
                    If Acell = "合计" Or Acell = "总计" Or Acell = "总 计" Or Acell = "合 计" Then
                        cl.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter    '水平居中
                        If cl.ColumnIndex = .Columns.Count Then
                            .Columns(cl.ColumnIndex).Select
                            Selection.Font.Bold = True
                        Else
                            cl.Row.Range.Font.Bold = True
                        End If
                    ElseIf Acell = "序号" Or Acell = "序 号" Then
                        .Columns(cl.ColumnIndex).Select
                        Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter    '水平居中
                    End If
                End If
            Next
            '设置首行格式
            .Rows(1).Select ' 选中第一个单元格
            With Selection
                .Rows.HeadingFormat = wdToggle '自动标题行重复
                .ParagraphFormat.Alignment = wdAlignParagraphCenter   '水平居中
                .Range.Font.Bold = True '表头加粗黑体
                .Shading.ForegroundPatternColor = wdColorAutomatic '首行自动颜色
                .Shading.BackgroundPatternColor = -603923969 '首行底纹填充
                '.Borders(wdBorderBottom).LineStyle = xlContinuous
                '.Borders(wdBorderBottom).LineWidth = wdLineWidth50pt
            End With
            '自动调整表格
            .Columns.PreferredWidthType = wdPreferredWidthAuto
            .AutoFitBehavior (wdAutoFitContent) '根据内容调整表格
            .AutoFitBehavior (wdAutoFitWindow) '根据窗口调整表格
        End With
    Next
    '---------------------------------------------------------------------------------------
    ERR.Clear: On Error GoTo 0 '恢复错误捕捉
    Application.DisplayAlerts = True  '开启提示
    Application.ScreenUpdating = True   '开启屏幕刷新
End Sub
Sub 多表处理_表格选中(control As IRibbonControl) '
    Dim tempTable As Table
    'Application.ScreenUpdating = False
    '判断文档是否被保护
    If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
        MsgBox "文档已保护，此时不能选中多个表格！"
        Exit Sub
    End If
    '删除所有可编辑的区域
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    '添加可编辑区域
    For Each tempTable In ActiveDocument.Tables
        tempTable.Range.Editors.Add wdEditorEveryone
    Next
    '选中所有可编辑区域
    ActiveDocument.SelectAllEditableRanges wdEditorEveryone
    '删除所有可编辑的区域
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    'Application.ScreenUpdating = True
    MsgBox "完成"
End Sub