MS Word收缩文本溢出的多表使用VBA

Question

我有一个Word文档与多个表被填充的信息从Excel使用mailmerge。每个表中的第一个单元格都填充了一个人的名字，表中的每个单元格都有一个固定的宽度&高度。然而，有些名称太长，以至于它们溢出(带换行文本)，因此您无法看到全名。因为这是一个文档，最终将有100+表，我想在邮件合并后使用VBA脚本将那些溢出单元格的字体大小缩小1，直到在该单元格中没有溢出(我假设这将涉及一些循环的使用)。

表格要打印，因此名称需要尽可能大而不溢出，单元格的宽度/高度不能改变。什么好主意吗?我看过一些关于如何调整文本框溢出的例子，但我不确定这是否适用于表格中的单元格。我也很新的VBA所以请不要保留在你的解释，谢谢!

(作为旁注，我建议使用等宽字体根据字符长度设置字体大小的解决方案，但我被告知这是不可能的，并且仅限于Arial)

Answer 1

以下宏确保邮件合并中每个标签的输出不包含换行。长到通常不适合一行的文本将适合单元格的宽度。如上所述，宏拦截Edit Individual Documents命令，以便使该过程自动化。

Sub MailMergeToDoc()
Application.ScreenUpdating = False
Dim Tbl As Table, Cll As Cell, Par As Paragraph, sCllWdth As Single, sParWdth As Single
With ActiveDocument
With .Tables(1)
For Each Cll In .Range.Cells
Cll.WordWrap = False
Next
With .Cell(1, 1)
sCllWdth = .Width - .LeftPadding - .RightPadding
End With
End With
.MailMerge.Execute
End With
With ActiveDocument
For Each Tbl In .Tables
For Each Cll In Tbl.Range.Cells
If Len(Cll.Range) > 2 Then
For Each Par In Cll.Range.Paragraphs
With Par.Range
sParWdth = .Characters.Last.Previous.Information(wdHorizontalPositionRelativeToPage)
sParWdth = sParWdth - .Characters.First.Information(wdHorizontalPositionRelativeToPage)
If sParWdth + .LeftIndent > sCllWdth Then .FitTextWidth = sCllWdth - .LeftIndent
If .Characters.Last.Previous.Information(wdVerticalPositionRelativeToPage) <> _
.Characters.First.Information(wdVerticalPositionRelativeToPage) Then
.FitTextWidth = sCllWdth - .LeftIndent
End If
End With
Next
End If
Next
Next
End With
Application.ScreenUpdating = True
End Sub

选择最适合你需要的字体和点的大小。

注意:宏要求将合并使用的表单元格中的每个输出'行'用段落分隔，而不是手动换行。