ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 11270|回复: 20

[分享] 批量设置表格列宽(宏)

[复制链接]

TA的精华主题

TA的得分主题

发表于 2016-5-4 10:39 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
* 因 菜菜行者 朋友 的原帖子打开说有病毒,打不开,故出一新帖,提供宏代码:
  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
复制代码

评分

3

查看全部评分

TA的精华主题

TA的得分主题

发表于 2016-5-5 00:52 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2016-5-9 00:38 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-5-9 10:27 | 显示全部楼层
增加了《根据窗口调整表格》两行代码(两行代码一样,是录制宏),似乎可以了!
  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
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-4-20 09:13 | 显示全部楼层
413191246se 发表于 2016-5-9 10:27
增加了《根据窗口调整表格》两行代码(两行代码一样,是录制宏),似乎可以了!

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

TA的精华主题

TA的得分主题

发表于 2017-4-20 13:26 | 显示全部楼层
可以简化以下代码,如下:
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

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-4-21 09:44 | 显示全部楼层
谢谢!辛苦了!——但是,运行结果不正确,只有最后一列宽度正确,其它列均相等,都是1.71cm。

TA的精华主题

TA的得分主题

发表于 2017-12-9 21:38 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-1-17 20:37 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-7-26 11:29 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 21:38 , Processed in 0.051556 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表