Один из способов определить, переносится ли содержимое ячейки, состоит в сравнении нумерации строк начала и конца содержимого ячейки, как показано в следующем примере кода.
- Объектная модель Word предоставляет свойство
Information
, которое имеет множество членов перечисления, включая wdFirstCharacterLineNumber
. - Каждая ячейка в таблице проверяется в цикле. После определения номера строки первого символа в ячейке Range сворачивается до своей конечной точки (которая является началом следующей ячейки), затем перемещается назад на один символ (помещая его в исходную ячейку) и номер строкипоследний символ в ячейке проверяется.
- Если второй больше первого, ячейка добавляется в массив. (Примечание: возможно, вы могли бы обработать ячейку напрямую. Но если это может повлиять на другие ячейки, лучше сначала добавить их все в массив, затем обработать массив.)
- Наконец, массив зацикливается икаждая ячейка отформатирована с
FitText = True
Sub ChangeCellWrapForLongLinesOfText()
Dim tbl As Word.Table
Dim cel As Word.Cell
Dim rngCel As Word.Range
Dim multiLineCells() As Word.Cell
Dim firstLine As Long
Dim lastLine As Long
Dim i As Long, x As Long
Set tbl = ActiveDocument.Tables(1)
For Each cel In tbl.Range.Cells
Set rngCel = cel.Range
firstLine = rngCel.Information(wdFirstCharacterLineNumber)
rngCel.Collapse wdCollapseEnd
rngCel.MoveEnd wdCharacter, -1
lastLine = rngCel.Information(wdFirstCharacterLineNumber)
If lastLine > firstLine Then
ReDim Preserve multiLineCells(i)
Set multiLineCells(i) = cel
i = i + 1
End If
Next
'Debug.Print i, UBound(multiLineCells())
For x = LBound(multiLineCells()) To UBound(multiLineCells())
'Debug.Print multiLineCells(x).Range.Text
multiLineCells(x).FitText = True
Next
End Sub