1。我正在尝试做什么

Question

1。我正在尝试做什么

我有一个包含84个Word文档（.docx）的文件夹。每个文档都包含一个布局完全相同的表格（某些文档跨2页）。但是，列宽并不总是相同。

我想使所有表列的宽度相同，为2英寸，因此我可以将所有文件另存为PDF，并准备将其用于其他过程，而不再赘述。

2。我目前的方法

我有一个Word VBA宏，它根据用户提示的文件路径在文件夹中的所有.docx文件上运行脚本（如下）。这部分有效-没问题。

问题

但是，当我的脚本试图将文档表中的所有列设置为相同的宽度时，这将不起作用。在此处显示的示例文档中，它仅适用于前三列。

通过屏幕截图说明问题

图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宏。我在这两个地方将它们联机：

此处显示的示例文档是新加坡政府的财产：http://www.skillsfuture.sg/skills-framework

Answer 1

尝试根据以下内容进行尝试：

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

Answer 2

根据进一步的实验，我设法自己解决了该问题。

我怀疑问题与表格顶部的合并单元格有关，虽然我不确定确切地影响设置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即可按预期工作。结果如下图所示：

在Word宏VBA

1。我正在尝试做什么

2。我目前的方法

问题

通过屏幕截图说明问题

在另一个文件上测试

3。我的问题

4。 Word VBA宏

5。信用与免责声明

2 个答案: