PDA

View Full Version : [SOLVED:] Merged Cells Problem



framcc06
01-29-2019, 11:05 AM
Hi Folks,

The below code will adjust the height of rows in my table based on text length in the first column, however, my last row contains merged cells and I get run time error 5992 Cannot access individual columns in this collection because the table has mixed cell widths.

Would anyone be able to add or amend where the last row is excluded.

Thanks

Fra


Sub columntocheck()
Dim tbl As Word.Table
Dim ColToCheck As Long
Dim cel As Word.Cell
Set tbl = ActiveDocument.Tables(1) ' Table 1 change to suit
ColToCheck = 1 ' Column 1
tbl.Columns(ColToCheck).Select
For Each cel In Selection.Cells
If Len(cel.Range.Text) > 21 Then
cel.Range.Rows.Height = 30
End If
Next
End Sub

macropod
01-29-2019, 02:24 PM
A more sophisticated approach:

Sub Demo()
Application.ScreenUpdating = False
Dim r As Long
With ActiveDocument.Tables(1)
For r = 1 To .Rows.Count
With .Cell(r, 1)
If .Range.Characters.Last.Previous.Information(wdVerticalPositionRelativeToTex tBoundary) <> _
.Range.Characters.First.Information(wdVerticalPositionRelativeToTextBoundar y) Then
.Row.HeightRule = wdRowHeightExactly
.Row.Height = 30
End If
End With
Next
End With
Application.ScreenUpdating = True
End Sub

framcc06
01-30-2019, 10:00 AM
Thanks Paul,

I made some tweaks to get the outcome I needed.

Regards,

Fra


Sub Demo()
Application.ScreenUpdating = False
Dim r As Long
With ActiveDocument.Tables(1)
For r = 1 To .Rows.Count
With .Cell(r, 1)
If .Range.Characters.Count > 21 Then
.Row.HeightRule = wdRowHeightExactly
.Row.Height = 30
End If
End With
Next
End With
Application.ScreenUpdating = True
End Sub

macropod
01-30-2019, 01:21 PM
The reason for the approach I took is that a character count is an unreliable way of determining the space required when using proprotional fonts. The letter i, for example, is only a fraction of the width of the letter W.