在Word宏VBA中设置表列宽度

Question

1.我想做的事

我有一个包含84个Word文档(.docx)的文件夹。每个文档都包含一个布局相同的表(其中一些文档跨越2页)。但是，列的宽度并不总是相同的。

我想使所有的表列宽度相同的2英寸，因此我可以随后保存所有文件为PDF，并准备在另一个过程中使用，我将不详细说明。

2.我目前的做法

我有一个Word VBA宏，它基于用户提示的文件路径，在文件夹中的所有.docx文件上运行一个脚本(如下)。这部分起作用了-没问题。

问题所在

但是，当我的脚本试图将文档表中的所有列设置为相同宽度时，这是行不通的。在这里显示的示例文档中，它只在前3列上工作。

用截图说明问题

​

图1(上图)：这是Word文档中原始表的样子。

​

图2(上图)：这是运行我的宏后表的样子。在本例中，我运行宏将所有列宽度设置为1.5 (InchesToPoints(1.5))。您可以看到，只有前3列被调整，但列4-7是未经修改的.

​

图3(上图)：在运行宏将所有列设置为1.5英寸宽之后，这就是我期望的表的样子。

下面是指向原始文档的链接：https://www.dropbox.com/s/cm0fqr6o7xgavpv/1-Accounting-Standards.docx?dl=0

在另一个文件上进行测试

我在我创建的另一个文件上测试了宏，我在其中插入了3个表。

​

图4(上图)：我创建了一个包含3个表的新文件，这些表都有不同的列宽。

​

图5(上图)：在与前面的示例文档相同的文件夹中运行此测试文件的宏，显示宏工作，并将所有表中的列调整为指定的宽度。

3.我的问题

这里发生了什么事？为什么SetTableWidths不能像预期的那样工作？

我猜想这可能是因为原始word文档中的原始表包含合并的单元格，否则为什么脚本不能在4-7列上工作呢？

任何帮助都将不胜感激.

4. Word VBA宏

Sub RunMacroOnAllFilesInFolder()
    Dim flpath As String, fl As String
    flpath = InputBox("Please enter the path to the folder you want to run the macro on.")
    If flpath = "" Then Exit Sub

    If Right(flpath, 1) <> Application.PathSeparator Then flpath = flpath & Application.PathSeparator
    fl = Dir(flpath & "*.docx")
    Application.ScreenUpdating = False
    Do Until fl = ""
        MyMacro flpath, fl
        fl = Dir
    Loop
End Sub

Sub MyMacro(flpath As String, fl As String)
    Dim doc As Document
    Set doc = Documents.Open(flpath & fl)
    'Your code below

    SetTableWidths doc
    DeleteAllHeadersFooters doc

    'your code above
    doc.Save
    doc.Close SaveChanges:=wdSaveChanges
End Sub

Sub SetTableWidths(doc As Document)
    Dim t As Table
    For Each t In doc.Tables
        t.Columns.Width = InchesToPoints(2)
    Next t
End Sub

Sub DeleteAllHeadersFooters(doc As Document)

  Dim sec As Section
  Dim hd_ft As HeaderFooter

  For Each sec In ActiveDocument.Sections
    For Each hd_ft In sec.Headers
      hd_ft.Range.Delete
    Next
    For Each hd_ft In sec.Footers
      hd_ft.Range.Delete
    Next
  Next sec

End Sub

5.信贷及免责声明

我没有编写VBA宏。我在这两个地方把它们放到网上：

• Tables
• https://www.quora.com/How-do-I-automatically-run-a-macro-on-all-Word-files-docx-in-a-folder
• http://vba.relief.jp/word-macro-delete-all-headers-and-footers-active-document/

这里显示的示例文档是新加坡政府的属性：http://www.skillsfuture.sg/skills-framework

Answer 1

基于进一步的实验，我设法自己解决了这个问题。

我怀疑这个问题与表顶部的合并单元格有关，虽然我不确定内部代码中到底发生了什么影响设置t.Columns.Width的情况，但我发现在表的所有行中设置相同数量的列可以修复意外行为。

我在表的前3行拆分合并的单元格(请参见屏幕截图中的内容)。

Sub SplitMergedColumns(t As Table)
    'Merged columns causes issues for setting column width. This splits merged column cells.
    Dim a As Cell, b As Cell, c As Cell
    Set a = t.Cell(1, 2)
    Set b = t.Cell(2, 2)
    Set c = t.Cell(3, 2)
    a.Split NumRows:=1, NumColumns:=6
    b.Split NumRows:=1, NumColumns:=6
    c.Split NumRows:=1, NumColumns:=6
End Sub

然后，运行上面提到的Sub SetTableWidths就像预期的那样工作.结果就像这张截图：

​

Answer 2

尝试一些基于以下方面的东西：

Sub SetTableWidths(Doc As Document)
Dim Tbl As Table, c As Long, sWdth As Single
sWdth = InchesToPoints(14)
For Each Tbl In Doc.Tables
  With Tbl
    .PreferredWidthType = wdPreferredWidthPoints
    .PreferredWidth = sWdth
    sWdth = sWdth / 7
    With .Range
      For c = 1 To 5 Step 2
        .Cells(c).Width = sWdth
      Next
      For c = 2 To 6 Step 2
        .Cells(c).Width = sWdth * 6
      Next
      For c = 7 To .Cells.Count
        .Cells(c).Width = sWdth
      Next
    End With
  End With
Next
End Sub