【转载】word vba设置表格样式 - jes

View Post

【转载】word vba设置表格样式

来源于：https://blog.csdn.net/sandorn/article/details/86528762 

 

Sub 表格处理()
    \'功能：光标在表格中处理当前表格；否则处理所有表格！
    Application.ScreenUpdating = False  \'关闭屏幕刷新
    Application.DisplayAlerts = False  \'关闭提示
    On Error Resume Next  \'忽略错误
    \'***************************************************************************
    Dim mytable As Table, i As Long
    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
            \'取消底色
            .Shading.ForegroundPatternColor = wdColorAutomatic
            .Shading.BackgroundPatternColor = wdColorAutomatic
            Options.DefaultHighlightColorIndex = wdNoHighlight
            .Range.HighlightColorIndex = wdNoHighlight
            .Style = "表格主题"
            
            \'单元格边距
            .TopPadding = PixelsToPoints(0, True) \'设置上边距为0
            .BottomPadding = PixelsToPoints(0, True) \'设置下边距为0
            .LeftPadding = PixelsToPoints(0, True)  \'设置左边距为0
            .RightPadding = PixelsToPoints(0, True) \'设置右边距为0
            .Spacing = PixelsToPoints(0, True) \'允许单元格间距为0
            .AllowPageBreaks = True \'允许断页
            \'.AllowAutoFit = True \'允许自动重调尺寸
            
            \'设置边框
            .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
            .Borders(wdBorderRight).LineStyle = wdLineStyleNone
            .Borders(wdBorderTop).LineStyle = wdLineStyleThinThickMedGap
            .Borders(wdBorderTop).LineWidth = wdLineWidth225pt
            .Borders(wdBorderBottom).LineStyle = wdLineStyleThickThinMedGap
            .Borders(wdBorderBottom).LineWidth = wdLineWidth225pt
            
            With .Rows
                .WrapAroundText = False \'取消文字环绕
                .Alignment = wdAlignRowCenter \'表水平居中  wdAlignRowLeft \'左对齐
                .AllowBreakAcrossPages = False \'不允许行断页
                .HeightRule = wdRowHeightExactly \'行高设为最小值   wdRowHeightAuto \'行高设为自动
                .Height = CentimetersToPoints(0) \'上面缩进量为0
                .LeftIndent = CentimetersToPoints(0) \'左面缩进量为0
            End With
            
            With .Range
                With .Font \'字体格式
                    .Name = "宋体"
                    .Name = "Times New Roman"
                    .Color = wdColorAutomatic \'自动字体颜色
                    .Size = 12
                    .Kerning = 0
                    .DisableCharacterSpaceGrid = True
                End With
                
                With .ParagraphFormat \'段落格式
                    .CharacterUnitFirstLineIndent = 0 \'取消首行缩进
                    .FirstLineIndent = CentimetersToPoints(0) \'取消首行缩进
                    .LineSpacingRule = wdLineSpaceSingle \'单倍行距  wdLineSpaceExactly \'行距固定值
                    \'.LineSpacing = 20 \'设置行间距为20磅，配合行距固定值
                    .Alignment = wdAlignParagraphCenter \'单元格水平居中
                    .AutoAdjustRightIndent = False
                    .DisableLineHeightGrid = True
                End With
                
                .Cells.VerticalAlignment = wdCellAlignVerticalCenter  \'单元格垂直居中
                
            End With
            
            \'设置首行格式
            .Cell(1, 1).Select \' 选中第一个单元格
            With Selection
                .SelectRow \'选中当前行
                Selection.Rows.HeadingFormat = wdToggle \'自动标题行重复
                .Range.Font.Bold = True \'表头加粗黑体
                .Shading.ForegroundPatternColor = wdColorAutomatic \'首行自动颜色
                .Shading.BackgroundPatternColor = -603923969 \'首行底纹填充
            End With
            
            \'自动调整表格
            .Columns.PreferredWidthType = wdPreferredWidthAuto
            .AutoFitBehavior (wdAutoFitContent) \'根据内容调整表格
            .AutoFitBehavior (wdAutoFitWindow) \'根据窗口调整表格
            
        End With
        
        If i = 1 Then Exit For
    Next
    \'***************************************************************************
    Err.Clear: On Error GoTo 0 \'恢复错误捕捉
    Application.DisplayAlerts = True  \'开启提示
    Application.ScreenUpdating = True   \'开启屏幕刷新
End Sub