WORD调整表格样式

Sky11235 · 发表于 2018-7-23 21:37

经常要用到word,且文档里很多表格，请问怎么用VBA一次性修改所有表格的格式，具体要求：
1、表格属性：
（1）对齐方式：居中
（2）文字环绕：无
（3）指定高度：0.8厘米，行高值是：最小值
2、表格内文字要求：
（1）中文字体：宋体五号，英文字体：New Time Roman 5号；
（2）行距：固定值 20磅；
（3）对齐方式：水平居中，垂直居中；
3、表格自动调整方式：先根据内容自动调整表格，然后根据窗口自动调整表格。
要求比较多，奈何自己不懂VBA，恳请大神帮忙给段代码，感激不尽！

413191246se · 发表于 2018-7-24 00:08

楼主，表格固定值20磅，文字将不再居中！所以，恕难从命，表格仍为单倍行距，这样文字上下左右才居中。请试试如下代码（并非完美，勉强先用用吧！）：

Sub test表格样式()
Dim t As Table, c As Cell, i As Paragraph, j&, k&, x&, y&, z&, e&
For Each t In ActiveDocument.Tables
With t
With .Range '探测表格是否规则(e=1=规则，e=0=不规则）
.Find.Execute "^13", , , 0, , , , , , "^p", 2
.Find.Execute "^11", , , 0, , , , , , "^p", 2
x = .Information(wdEndOfRangeRowNumber)
y = .Information(wdEndOfRangeColumnNumber)
z = .Cells.Count
End With
If x <> 1 Then
If z = x * y Then
For k = 1 To y
For j = 1 To x - 1
If .Cell(j + 1, k).Width = .Cell(j, k).Width Then e = 1 Else e = 0
If e = 0 Then Exit For
Next j
If e = 0 Then Exit For
Next k
Else
e = 0
End If
Else
e = 1
End If
With .Rows
.WrapAroundText = False
.Alignment = wdAlignRowLeft
.LeftIndent = CentimetersToPoints(0)
.HeightRule = wdRowHeightAtLeast
.Height = CentimetersToPoints(0.8)
End With
.LeftPadding = CentimetersToPoints(0.19)
.RightPadding = CentimetersToPoints(0.19)
.Select
Selection.MoveDown 4, 1, 1
CommandBars.FindControl(ID:=122).Execute
CommandBars.FindControl(ID:=123).Execute
.Select
Selection.ClearFormatting
With .Range
With .Font
.Kerning = 0
.DisableCharacterSpaceGrid = True
End With
With .ParagraphFormat
.CharacterUnitFirstLineIndent = 0
.FirstLineIndent = CentimetersToPoints(0)
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphCenter
.AutoAdjustRightIndent = False
.DisableLineHeightGrid = True
' .LineSpacingRule = wdLineSpaceExactly'固定值20磅
' .LineSpacing = 20
End With
.Cells.VerticalAlignment = wdCellAlignVerticalCenter
End With
.AutoFitBehavior (wdAutoFitContent) '根据内容调整表格
.AutoFitBehavior (wdAutoFitContent)
.Select
.AutoFitBehavior (wdAutoFitWindow) '根据窗口调整表格
.AutoFitBehavior (wdAutoFitWindow)
'规则表格表头加粗（表头即表格第一行）
If e = 1 Then
If Len(.Cell(2, 1).Range) > 2 Then
With .Rows(1).Range.Font
.Name = "黑体"
.Name = "Times New Roman"
.Bold = True
.Color = wdColorRed
End With
End If
End If
'删除单元格内空行
For Each c In .Range.Cells
For Each i In c.Range.Paragraphs
If Asc(i.Range) = 13 And Len(i.Range) = 1 Then i.Range.Delete
Next
With c.Range.Paragraphs
If .Count > 1 And Len(.Last.Range) = 2 Then
.Last.Previous.Range.Characters.Last.Delete
End If
End With
Next
End With
Next
End Sub

复制代码

ming0018 · 发表于 2018-7-24 08:40

Sub 表格排版()
Dim TablesCount%, doc As Document
Set doc = ActiveDocument
TablesCount = doc.Tables.Count
If TablesCount = 0 Then Exit Sub '无表格退出
Dim myRng As Range, myTable As table
For Each myTable In doc.Tables
Set myRng = myTable.Range
With myRng '表格文字排版
.Font.Size = 10.5 '五号字体
.Font.Name = "宋体"
With .ParagraphFormat
.LineSpacingRule = wdLineSpaceExactly '行距-固定值
.LineSpacing = 20
.Alignment = wdAlignParagraphCenter
.CharacterUnitFirstLineIndent = 0
.FirstLineIndent = 0
End With
End With
With myRng
.Rows.Alignment = wdAlignRowCenter
.Rows.AllowBreakAcrossPages = False '允许断页
.Rows.WrapAroundText = False '无环绕
.Rows.HeightRule = wdRowHeightExactly '行高设为最小值
.Rows.Height = CentimetersToPoints(0.8) '行高
.ParagraphFormat.Alignment = wdAlignParagraphCenter '水平居中
.Cells.VerticalAlignment = wdCellAlignVerticalCenter '垂直居中
.Columns.PreferredWidthType = wdPreferredWidthAuto
'.Columns.PreferredWidth = 0
With .Tables(1)
' .TopPadding = CentimetersToPoints(0)
' .BottomPadding = CentimetersToPoints(0)
' .LeftPadding = CentimetersToPoints(0)
' .RightPadding = CentimetersToPoints(0)
' .Spacing = CentimetersToPoints(0)
' .AllowPageBreaks = False
' .AllowAutoFit = True
.AutoFitBehavior (wdAutoFitContent) '根据内容调整表格
.AutoFitBehavior (wdAutoFitWindow) '根据窗口调整表格
End With
End With
Next
End Sub

复制代码

413191246se · 发表于 2018-7-24 11:35

ming朋友：终于出手了！厉害！我要好好学学你的代码。——楼主，请用 ming朋友的代码吧，他是高手，我是低手。

Sky11235 · 发表于 2018-7-24 12:44

ming0018 发表于 2018-7-24 08:40

非常感谢，很好用。发现2个小问题：
（1）宏设置出来的表格行高是固定值，不是最小值，百度了下，把wdRowHeightExactly改成wdRowHeightAtLeast就好了；
（2）所有字体都是宋体，没有把英文改为New Time Roman，已经百度解决了。
再次感谢大神！

Sky11235 · 发表于 2018-7-24 12:46

413191246se 发表于 2018-7-24 11:35
ming朋友：终于出手了！厉害！我要好好学学你的代码。——楼主，请用 ming朋友的代码吧，他是高手，我是低 ...

采用了ming0018的代码。
也谢谢你的帮忙写的代码，感谢！

Sky11235 · 发表于 2018-7-24 12:49

ming0018 发表于 2018-7-24 08:40

非常感谢，很好用，虽然有2个小问题（没有变更英文字体，表格行高是固定值而非最小值），不过我都百度解决了。

Sky11235 · 发表于 2018-7-24 13:04

ming0018 发表于 2018-7-24 08:40

您好！再请教下，使用过程中发现，我文档中有些表格格式要求不是这样的，而这个宏是将文档内所有的表格都修改成这样。如果我想只修改我选定了的表格的格式，这个宏应该怎么修改？感谢。

yhs185 · 发表于 2018-7-24 14:34

把不改的再复制粘贴回来。

ming0018 · 发表于 2018-7-24 14:35

Sky11235 发表于 2018-7-24 12:49
非常感谢，很好用，虽然有2个小问题（没有变更英文字体，表格行高是固定值而非最小值），不过我都百度解 ...

随便写的，是的，表格行高我设成固定值了，英文字体很简单了，既然你已经解决了，说明你的基本功还是有的，有发展的空间！

		自动登录	找回密码
密码			免费注册

WORD调整表格样式

评分