word vba 操作表格，使用表格样式调整表格格式

原创

CPA657499934 2022-12-29 18:05:32 博主文章分类：Word VBA ©著作权

文章标签 自定义表格样式 vba设置word表格样式 文章分类 办公效率

©著作权归作者所有：来自51CTO博客作者CPA657499934的原创作品，请联系作者获取转载授权，否则将追究法律责任

一、新建和删除表格样式

Sub 表格样式()
  Dim oldstyle As Style, tablestyle As Style
'  On Error Resume Next
  '删除表格样式
  'ActiveDocument.Styles("mytablestyle").Delete
  
  '在创建之前，判断样式是否存在，如果存在自定义的样式则删除
  For Each oldstyle In ActiveDocument.Styles
    If oldstyle.NameLocal = "mytablestyle" Then
      oldstyle.Delete
    End If
  Next oldstyle
  
  '创建一个表格样式
  Set tablestyle = ActiveDocument.Styles.Add( _
  Name:="mytablestyle", Type:=wdStyleTypeTable)
'  WdStyleType 枚举
'  指定要应用的样式类型?
'  名称                    值    说明
'  wdStyleTypeParagraph    1    段落样式。
'  wdStyleTypeCharacter    2    正文字符样式。
'  wdStyleTypeTable        3    表格样式。
'  wdStyleTypeList         4    列表样式。
End Sub

二、设置一个表格样式,通过调用表格样式，调整表格格式

Sub 调整表格()
  '1、新建表格样式
  Call 创建表格样式
  Dim t As Table
  For Each t In ActiveDocument.Tables
    '2初始化表格
    Call 初始化(t)
    '3使用自定义样式
    t.Style = "mytablestyle"
    '4表格样式之中无法使用vba设置？单独设置
    Call 布局设置(t)
    '5替换掉表格中的特殊符号
    Call 查找替换(t)
  Next t
End Sub
'==========================================
Private Sub 创建表格样式()
  Dim oldstyle As Style, tablestyle As Style
  On Error Resume Next
'  删除表格样式
  ActiveDocument.Styles("mytablestyle").Delete
  
  '判断样式是否存在，如果存在自定义的样式则删除
'  For Each oldstyle In ActiveDocument.Styles
'    If oldstyle.NameLocal = "mytablestyle" Then
'      oldstyle.Delete
'    End If
'  Next oldstyle
  
  '创建一个表格样式
  Set tablestyle = ActiveDocument.Styles.Add( _
  Name:="mytablestyle", Type:=wdStyleTypeTable)
  '样式基准
'  在该基准样式的基础上进行修改设置，
'  没有单独设置的部分会继承基准样式
  tablestyle.BaseStyle = "普通表格"
  
'  WdStyleType 枚举
'  指定要应用的样式类型?
'  名称                    值    说明
'  wdStyleTypeParagraph    1    段落样式。
'  wdStyleTypeCharacter    2    正文字符样式。
'  wdStyleTypeTable        3    表格样式。
'  wdStyleTypeList         4    列表样式。
'------------------------------------------------------
'设置样式的字体格式
  With tablestyle.Font
    .NameFarEast = "宋体"
    .NameAscii = "Times New Roman"
    .Bold = False
    .Italic = False
    .Size = 9
    .ColorIndex = wdBlack
    .Underline = wdUnderlineNone
    .UnderlineColor = wdColorBlack
    .EmphasisMark = wdEmphasisMarkNone
    .StrikeThrough = False
    .DoubleStrikeThrough = False
    .Superscript = False
    .Subscript = False
    .SmallCaps = False
    .AllCaps = False
    .Hidden = False
  End With
'-------------------------------------------
'设置样式的段落格式
  With tablestyle.ParagraphFormat
    .Alignment = wdAlignParagraphRight
    .OutlineLevel = wdOutlineLevelBodyText
    .CharacterUnitLeftIndent = 0
    .CharacterUnitRightIndent = 0
    .CharacterUnitFirstLineIndent = 0
    .LeftIndent = 0
    .RightIndent = 0
    .FirstLineIndent = 0
    .LineUnitBefore = 0
    .LineUnitAfter = 0
    
    .WidowControl = False
    .KeepWithNext = False
    .KeepTogether = False
    .PageBreakBefore = False
    .WordWrap = False
    .NoLineNumber = False
    
    .FarEastLineBreakControl = False
    .WordWrap = False
    .HangingPunctuation = False
    
    .HalfWidthPunctuationOnTopOfLine = False
    .AddSpaceBetweenFarEastAndAlpha = False
    .AddSpaceBetweenFarEastAndDigit = False
  End With
'------------------------------------------------
  '设置表格属性
  With tablestyle.Table
    '单元格边距
    .TopPadding = CentimetersToPoints(0)
    .BottomPadding = CentimetersToPoints(0)
    .LeftPadding = CentimetersToPoints(0)
    .RightPadding = CentimetersToPoints(0.15)
    '默认单元格间距 不勾选，注意设置为0和不勾选有区别
'    .Spacing = 0
'    行的左缩进值
'    .LeftIndent = CentimetersToPoints(0)
    '底纹设置
    With .Shading
      .Texture = wdTextureNone
      .ForegroundPatternColor = wdColorAutomatic
      .BackgroundPatternColor = wdColorAutomatic
    End With
    '边框设置
    With .Borders(wdBorderTop) '上边框
      .LineStyle = wdLineStyleDouble '线型样式
      .LineWidth = wdLineWidth025pt '宽度
      .Color = wdColorBlack '颜色
    End With
    
    With .Borders(wdBorderBottom) '下边框
      .LineStyle = wdLineStyleDouble
      .LineWidth = wdLineWidth025pt
      .Color = wdColorBlack
    End With
    '左边框
    .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
    '右边框
    .Borders(wdBorderRight).LineStyle = wdLineStyleNone
    '横框
    .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
    '竖框
    .Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
    
'    边框阴影格式
    .Borders.Shadow = False
    
    .Alignment = wdAlignRowRight
'    tablestyle.Condition 方法
'    表示表格某个部分的特殊样式格式设置的 ConditionalStyle 对象。
  End With
End Sub
'================================================
Private Sub 初始化(t As Table)
  '断开链接
  t.Range.Fields.Unlink
  '清除格式
  t.Select
  Selection.ClearFormatting
  t.Style = "普通表格"
End Sub
'===============================================
Private Sub 布局设置(t As Table)
  '设置样式之中，vba设置不方便或者不起作用的样式
  '1 设置对齐方式--水平
  '全部水平右对齐
  t.Range.ParagraphFormat.Alignment = wdAlignParagraphRight
  '第一列 水平左对齐
  Dim c As Integer
  For c = 1 To t.Range.Columns(1).Cells.Count
    t.Range.Columns(1).Cells(c).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
  Next c
  '第一行 水平居中
  t.Range.Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
  '最后一行，如果是 合计 行，则居中
  If Split(t.Rows.Last.Cells(1).Range.Text, Chr(13))(0) = "合计" Then
    '最后一行的第一个单元格居中
    t.Rows.Last.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
    '整行居中
    't.Rows.Last.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
  End If
'  设置对齐方式--垂直
  t.Select
  Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
  
  '2 设置行高列宽
  '平均列宽
  t.Columns.DistributeWidth
  '设置行高
  t.Rows.HeightRule = wdRowHeightAtLeast
  t.Rows.Height = Word.CentimetersToPoints(0.6)
  
  '3重复标题行
  't.Rows.HeadingFormat = false'关闭整体
  '将第1行设置为标题行,并重复标题行
  t.Rows(1).HeadingFormat = True
End Sub
'=======================================================
Private Sub 查找替换(t As Table)
  With t.Range.Find
    .Execute FindText:="^p", ReplaceWith:="", Replace:=wdReplaceAll
    .Execute FindText:="^t", ReplaceWith:="", Replace:=wdReplaceAll
    .Execute FindText:=" ", ReplaceWith:="", Replace:=wdReplaceAll
  End With
End Sub