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
|
相关文章：VBA 35
