当输入行高度与单词vba中的垂直和水平合并单元格表时发生错误

问题描述 投票:0回答:1

我想使用InputBox设置给定参数,以更改光标现在位置或突出显示区域上的表行高度。当我用鼠标突出显示多行时,我可以这样做,但是当我将光标放在字表中的特定单行中时,我也想做同样的事情。但是,当涉及到具有垂直合并单元格的表时,我无法做到这一点。 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

并且当我执行此子程序时,将显示以下错误消息:

Run time error:5991
Cannot access individual rows in the collection because the table has vertically merged cells.
word-vba word
1个回答
0
投票

尝试以下方式:

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
© www.soinside.com 2019 - 2024. All rights reserved.