批量设置表格列宽（宏）

413191246se

* 因 菜菜行者 朋友 的原帖子打开说有病毒，打不开，故出一新帖，提供宏代码：

1. Sub 表格列宽设置()
   
2. '若干表格，每表7列
   
3.     On Error Resume Next
   
4.     Dim t As Table
   
5.     For Each t In ActiveDocument.Tables
   
6.         t.Select
   
7.         Selection.Cells.DistributeWidth
   
8.         Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
   
9.         Selection.Columns(1).PreferredWidth = CentimetersToPoints(1.1) '第1列宽度值（单位：厘米），可自行修改
   
10.         Selection.Columns(2).PreferredWidth = CentimetersToPoints(0.8)
    
11.         Selection.Columns(3).PreferredWidth = CentimetersToPoints(2.4)
    
12.         Selection.Columns(4).PreferredWidth = CentimetersToPoints(1.3)
    
13.         Selection.Columns(5).PreferredWidth = CentimetersToPoints(0.9)
    
14.         Selection.Columns(6).PreferredWidth = CentimetersToPoints(1.8)
    
15.         Selection.Columns(7).PreferredWidth = CentimetersToPoints(6.73) '此列宽度=总宽度-前6列宽之和
    
16.     Next
    
17.     Selection.HomeKey Unit:=wdStory
    
18. End Sub

复制代码

菜菜行者

谢谢楼主，终于等到答案了。

菜菜行者

如果表格指定宽度是打勾的，则无效。

413191246se

增加了《根据窗口调整表格》两行代码（两行代码一样，是录制宏），似乎可以了！

1. Sub 表格列宽设置()
   
2. '若干表格，每表7列
   
3.     On Error Resume Next
   
4.     Dim t As Table
   
5.     For Each t In ActiveDocument.Tables
   
6.         t.Select
   
7.         With Selection
   
8.             .Tables(1).AutoFitBehavior (wdAutoFitWindow) '根据窗口调整表格
   
9.             .Tables(1).AutoFitBehavior (wdAutoFitWindow) '根据窗口调整表格
   
10.             .Cells.DistributeWidth '平均分布各列
    
11.             .Columns.PreferredWidthType = wdPreferredWidthPoints '列宽（单位：厘米）
    
12.             .Columns(1).PreferredWidth = CentimetersToPoints(1.1) '第1列列宽（可自行修改）
    
13.             .Columns(2).PreferredWidth = CentimetersToPoints(0.8)
    
14.             .Columns(3).PreferredWidth = CentimetersToPoints(2.4)
    
15.             .Columns(4).PreferredWidth = CentimetersToPoints(1.3)
    
16.             .Columns(5).PreferredWidth = CentimetersToPoints(0.9)
    
17.             .Columns(6).PreferredWidth = CentimetersToPoints(1.8)
    
18.             .Columns(7).PreferredWidth = CentimetersToPoints(6.73) '第7列列宽=表格总宽度-前6列列宽之和
    
19.         End With
    
20.     Next
    
21.     Selection.HomeKey Unit:=wdStory
    
22. End Sub

复制代码

lanccc

413191246se 发表于 2016-5-9 10:27
增加了《根据窗口调整表格》两行代码（两行代码一样，是录制宏），似乎可以了！

如果有一行是合并单元格列宽设置不会成功，这种情况下怎么设置除合并单元格之外的其他单元格列宽

weiyingde

可以简化以下代码，如下：
Sub 表格列宽设置()
'若干表格，每表7列
    On Error Resume Next
    Dim arr
    arr = Array(1.1, 0.8, 2.4, 1.3, 0.9, 1.8, 6.73)
    l = LBound(arr)
    u = UBound(arr)
    Dim t As Table
    For Each t In ActiveDocument.Tables
        t.Select
        For i = l To u
            Selection.Cells.DistributeWidth
            Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
            Selection.Columns(i + 1).PreferredWidth = CentimetersToPoints(arr(i)) '第1列宽度值（单位：厘米），可自行修改
        Next
    Next
    Selection.HomeKey Unit:=wdStory
End Sub

413191246se

谢谢！辛苦了！——但是，运行结果不正确，只有最后一列宽度正确，其它列均相等，都是1.71cm。

我的电子表1516

谢谢楼主分享。。。

qinhuan66

好好学习天天向上，

ost

太棒了，谢谢