WORD表格列宽规范调整

woyaofacai

比较复杂的问题，在文档中，有N个表格，列数并不固定，但存在列数相同的表格，（正式的一个文档中有300多个表格）能否按下面条件做到用VBA一次性规范文档中的列宽：

1、如果表格列数为2列，则平均列宽；  2、如果列数为3-5列，第1列为6.5CM，其余二列按页宽自动平均，3、如果列数为6列以上，第1 列为3.5CM，余下列数按页宽平均呢？ 表格样式.rar (14.71 KB, 下载次数: 20)

2020-3-16 15:11 上传

点击文件名下载附件

cuanju

做了部分功能，请各位继续完善
===========================
Sub d5()
    Dim Tbl As Table
    Rem 除第1列外平均分布各列
    For Each Tbl In ActiveDocument.Tables
        iCol = Tbl.Columns.Count
        iStart = Tbl.Cell(1, 2).Range.Start
        iEnd = Tbl.Cell(Tbl.Rows.Count, iCol).Range.End
        Set oRng = ActiveDocument.Range(iStart, iEnd)
        oRng.Select
        oRng.Cells.DistributeWidth
    Next
    Rem 第1列列宽均为6.5厘米
    For Each Tbl In ActiveDocument.Tables
        Tbl.Columns(1).Width = CentimetersToPoints(6.5)
    Next
End Sub

sylun

可试试如下代码：

1. Sub test()
   
2.     '假设表格为普通表格
   
3.     Dim aTable As Table
   
4.     Application.ScreenUpdating = False
   
5.     For Each aTable In ActiveDocument.Tables
   
6.         With aTable
   
7.             .Rows.WrapAroundText = False '取消表格文字环绕
   
8.             .PreferredWidthType = wdPreferredWidthPercent
   
9.             .PreferredWidth = 100 '表格宽度为版心宽度
   
10.             .Columns.DistributeWidth
    
11.             .Columns(1).PreferredWidthType = wdPreferredWidthPoints
    
12.             Select Case .Columns.Count
    
13.             Case 3 To 5
    
14.                 .Columns(1).PreferredWidth = CentimetersToPoints(6.5)
    
15.             Case Is > 5
    
16.                 .Columns(1).PreferredWidth = CentimetersToPoints(3.5)
    
17.             End Select
    
18.         End With
    
19.     Next
    
20.     Application.ScreenUpdating = True
    
21.     MsgBox "共处理了" & ActiveDocument.Tables.Count & "个表格。"
    
22. End Sub

复制代码

woyaofacai

谢楼上二位代码，解决问题了

413191246se

cuanju 朋友 和 sylun 老师 又出手了！

zhshbding

感谢两位老师