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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
| Dim aarr(1 To 20), bbrr(1 To 30, 1 To 30) '多列调整
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 Selection.Tables
With mytable
.Shading.ForegroundPatternColor = wdColorAutomatic
.Shading.BackgroundPatternColor = wdColorAutomatic
Options.DefaultHighlightColorIndex = wdNoHighlight
.Range.HighlightColorIndex = wdNoHighlight
.Style = "表格主题"
With .Borders(wdBorderLeft) '左框线
.LineStyle = wdLineStyleSingle '设置线条样式 不需要线条则填wdLineStyleNone
.LineWidth = wdLineWidth150pt '宽度为1.5
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
With .Borders(wdBorderHorizontal) '内部横向框线
.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) '列宽调整-多列加载
Set mytable = Selection.Tables(1)
For i = 1 To mytable.Rows.Count
For j = 1 To mytable.Rows(i).Cells.Count
mytable.Rows(i).Cells(j).Width = bbrr(i, j)
Next j
Next i
End Sub
Sub 格宽调整_读取(control As IRibbonControl) '列宽调整-多列读取
Set mytable = Selection.Tables(1)
mytable.AutoFitBehavior (wdAutoFitFixed)
For i = 1 To mytable.Rows.Count
For j = 1 To mytable.Rows(i).Cells.Count
bbrr(i, j) = mytable.Rows(i).Cells(j).Width
Next j
Next i
End Sub
Sub 列宽调整_读取(control As IRibbonControl) '列宽调整-单列读取
With Selection.Tables(1)
ColumnsCounts = .Columns.Count
For i = 1 To ColumnsCounts
aarr(i) = .Columns(i).Width
Next
End With
End Sub
Sub 列宽调整_释放(control As IRibbonControl) '列宽调整-单列加载
With Selection.Tables(1)
.AutoFitBehavior (wdAutoFitFixed)
ColumnsCounts = .Columns.Count
For i = 1 To ColumnsCounts
.Columns(i).Width = aarr(i)
Next
End With
End Sub
|
相关文章：VBA 35
