|
|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub AllTableBorders(control As IRibbonControl) '批量调整表格格式
Application.ScreenUpdating = False '关闭屏幕刷新
Application.DisplayAlerts = False '关闭提示
On Error Resume Next '忽略错误
'-------------------------------------------------------------------------
Dim mytable As table, i As Long, n As Range
If Selection.Information(wdWithInTable) = True Then i = 1
For Each mytable In ActiveDocument.Tables
If i = 1 Then Set mytable = Selection.Tables(1)
With mytable
.Style = "附注表格"
End With
If i = 1 Then Exit For
Next
'---------------------------------------------------------------------------------------
Err.Clear: On Error GoTo 0 '恢复错误捕捉
Application.DisplayAlerts = True '开启提示
Application.ScreenUpdating = True '开启屏幕刷新
End Sub
Sub SingleTableBorders(control As IRibbonControl) '
Application.ScreenUpdating = False '关闭屏幕刷新
Application.DisplayAlerts = False '关闭提示
On Error Resume Next '忽略错误
'-------------------------------------------------------------------------
Dim mytable As table, i As Long, n As Range
Set mytable = Selection.Tables(1)
With mytable
.Style = "附注表格"
End With
Err.Clear: On Error GoTo 0 '恢复错误捕捉
Application.DisplayAlerts = True '开启提示
Application.ScreenUpdating = True '开启屏幕刷新
End Sub
Sub FormatAllTable(control As IRibbonControl) '批量调整表格格式
'功能：光标在表格中处理当前表格；否则处理所有表格！
Application.ScreenUpdating = False '关闭屏幕刷新
Application.DisplayAlerts = False '关闭提示
On Error Resume Next '忽略错误
'-------------------------------------------------------------------------
Dim mytable As table, n As Range
For Each mytable In ActiveDocument.Tables
With mytable
.Style = "附注表格"
'单元格边距
If Err.Number = 5843 Then '指定的工作表不存在
MsgBox "设置表格样式，并将其命名为“附注表格”"
Exit Sub
End If
.TopPadding = PixelsToPoints(2, True) '设置上边距为2
.BottomPadding = PixelsToPoints(2, True) '设置下边距为2
.LeftPadding = PixelsToPoints(7, True) '设置左边距为7
.RightPadding = PixelsToPoints(7, True) '设置右边距为7
.Spacing = PixelsToPoints(0, True) '允许单元格间距为0
.AllowPageBreaks = True '允许断页
'.AllowAutoFit = True '允许自动重调尺寸
With .Rows
.WrapAroundText = False '取消文字环绕
.AllowBreakAcrossPages = False '不允许行断页
.HeightRule = wdRowHeightAtLeast '行高设为最小值 wdRowHeightAuto '行高设为自动
.Height = CentimetersToPoints(0.6) '上面缩进量为0
.LeftIndent = CentimetersToPoints(0) '左面缩进量为0
End With
Selection.Font.Name = "宋体"
Selection.Font.Size = 11
With Selection.Font
.NameFarEast = ""
.NameAscii = ""
.NameOther = ""
.Name = ""
.Spacing = -1
.Scaling = 100
.Kerning = 0
.DisableCharacterSpaceGrid = True
End With
With .Range
With .ParagraphFormat '段落格式
.LineUnitBefore = 0.2 '段前0.2
.LineUnitAfter = 0.2 '段后0.2
.SpaceBefore = 0
.SpaceAfter = 0
.CharacterUnitFirstLineIndent = 0 '取消首行缩进
.FirstLineIndent = CentimetersToPoints(0) '取消首行缩进
.CharacterUnitLeftIndent = -0.3 '左缩进
.CharacterUnitRightIndent = -0.3 '右缩进
.LineSpacingRule = wdLineSpaceExactly '行距固定值
.LineSpacing = 14 '设置行间距为14磅，配合行距固定值
'.LineSpacingRule = wdLineSpaceSingle '单倍行距 wdLineSpaceExactly '行距固定值
.Alignment = wdAlignParagraphCenter '单元格水平居中
.AutoAdjustRightIndent = False '自动调整所选段落的右缩进
.DisableLineHeightGrid = True '选定段落中的字符与行网格对齐
End With
.Cells.VerticalAlignment = wdCellAlignVerticalCenter '单元格垂直居中
.ParagraphFormat.Alignment = wdAlignParagraphRight
With Selection
For Each cl In Selection.Cells
Acell = ActiveDocument.Range(cl.Range.Start, cl.Range.End - 1).Text '提取文本
If IsNumeric(Acell) = False Then
Acell.ParagraphFormat.Alignment = wdAlignParagraphRight '数字靠右对齐
End If
Next
End With
End With
.Cell(1, 1).Select ' 选中第一个单元格
With Selection
.SelectColumn
Selection.ParagraphFormat.Alignment = wdAlignRowLeft '左数第一列左对齐
End With
'设置首行格式
.Cell(1, 1).Select ' 选中第一个单元格
With Selection
.SelectRow '选中当前行
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter '垂直水平居中
Selection.Rows.HeadingFormat = wdToggle '自动标题行重复
End With
.Cell(mytable.Rows.Count, 1).Select '选中首列最后一个单元格
With Selection
Selection.ParagraphFormat.Alignment = wdAlignRowCenter
End With
With Selection.Tables(1)
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleDouble
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleDouble
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderHorizontal)
.LineStyle = wdLineStyleDot
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderVertical)
.LineStyle = wdLineStyleDot
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
With Options
.DefaultBorderLineStyle = wdLineStyleDot
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
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
|
-
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2021-10-25 09:41
楼主