ошибка при вводе высоты строки с вертикальной и горизонтальной объединенной таблицей ячеек в слове vba

Question

Я хотел бы использовать InputBox, чтобы установить данный параметр для изменения высоты строки таблицы в текущей позиции курсора или в выделенной области. Я мог бы сделать это, когда выделил мышкой многострочную строку, но я также хотел бы сделать то же самое, когда просто поместил свой курсор в определенную c единственную строку в таблице слов. Однако, когда дело доходит до таблицы с вертикально объединенными ячейками, я не мог этого сделать. VBA покажет сообщение об ошибке: Ошибка времени выполнения: «5991». Есть ли способ изменить высоту строки или ширину столбца в таблице с вертикальной и горизонтальной таблицей объединенных ячеек?

Вот сценарий, который я предлагаю:

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

sub появится следующее сообщение об ошибке:

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

Answer 1

Попробуйте что-нибудь вроде:

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