i多表处理

i多表处理#

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
目录:
Categories
程技
Tags
VBA