error when input row height with vertical and horizontal merged cell table in word vba

Question

I would like to use InputBox to set the given parameter to change the table row height on cursor now position or the highlighted area. I could do this when I highlighted multi-row by mouse, but I also would like to do the same thing when I just put my cursor in a specific single row in the word table. However, when it comes to a table with vertically merged cells, I couldn't do that. VBA would show the error message: Run time error:'5991'. Is there any way to modify the row height or column width among a table with vertical and horizontal merged cells table?

Here is the script I propose:

Sub TableChangeSelectedRowHeight()
PromptBottom = "Input Row Height for Selection _________ mm"
HeaderTop = "Adjust Row Height"
UserData = InputBox(PromptBottom, HeaderTop)

Dim ToPoint As Single
ToPoint = Application.CentimetersToPoints(UserData / 10)

If StrPtr(UserData) = 0 Then
    MsgBox "您取消輸入。"
ElseIf UserData = vbNullString Then
    MsgBox "您沒有輸入資料。"
    End
Else
If Selection.Information(wdWithInTable) = True And Selection.Rows.Count <> 1 Then 'for mutltiple row
        Selection.Cells.SetHeight RowHeight:=ToPoint, _
        HeightRule:=wdRowHeightAtLeast

ElseIf Selection.Information(wdWithInTable) = True And 
    Selection.Rows.Count = 1 Then 'for single row
        aa = Selection.Cells(1).RowIndex
        Selection.Rows(aa).SetHeight RowHeight:=ToPoint, _ 
        HeightRule:=wdRowHeightAtLeast 'There are some problems here 
Else
        MsgBox "The insertion point is not in a table."
End If

End If

End Sub

and when I conduct the sub the following error message would show:

Run time error:5991
Cannot access individual rows in the collection because the table has vertically merged cells.

macropod macropod · Accepted Answer · 2020-05-29T13:22:31

Try something along the lines of:

Dim Cl As Cell, Rng As Range, r As Long
With Selection
  If .Information(wdWithInTable) = True Then
    For r = .Cells(1).RowIndex To .Cells(.Cells.Count).RowIndex
      Set Rng = Nothing
      With .Tables(1)
        For Each Cl In .Range.Cells
          With Cl
            If .RowIndex = r Then
              If Rng Is Nothing Then
                Set Rng = .Range
              Else
                Rng.End = .Range.End
              End If
            End If
          End With
        Next
        Rng.Cells.HeightRule = wdRowHeightAtLeast
        Rng.Cells.Height = CentimetersToPoints(UserData / 10)
      End With
    Next
  Else
    MsgBox "The insertion point is not in a table."
  End If
End With

error when input row height with vertical and horizontal merged cell table in word vba

1 Answers