如何用VBA均匀分配PowerPoint表格第二行至末行的高度

你的核心问题是剩余行高的计算公式错误：

• 原代码把-1放在除法运算外，导致每行高度被多减了1；
• 除数应该是总行数减1（因为第一行已固定，剩下需要均分的是Rows.Count - 1行），而不是总行数。

另外，原代码里With ActivePresentation.Slides(2)是多余的，应该直接取当前表格的第一行初始高度，而非固定第2张幻灯片的表格行高。

修正后的完整代码 #

Sub AdjustTableHeight()
    Dim oShp As Shape
    Dim oSld As Slide
    Dim p As Integer
    Dim masterShape As Shape
    Dim firstRowHeight As Single
    Dim totalRows As Integer
    Dim remainingHeight As Single
    Dim rowHeight As Single
    
    ' 定位到"标题与内容"版式的内容占位符
    Set masterShape = ActivePresentation.SlideMaster.CustomLayouts(2).Shapes.Placeholders(2)
    
    For Each oSld In ActivePresentation.Slides
        For Each oShp In oSld.Shapes
            If oShp.HasTable = msoTrue Then
                ' 记录当前表格第一行的初始高度
                firstRowHeight = oShp.Table.Rows(1).Height
                totalRows = oShp.Table.Rows.Count
                
                ' 让表格匹配占位符的位置和尺寸
                oShp.Left = masterShape.Left
                oShp.Top = masterShape.Top
                oShp.Width = masterShape.Width
                oShp.Height = masterShape.Height ' 先让表格总高度等于占位符高度
                
                ' 固定第一行高度
                oShp.Table.Rows(1).Height = firstRowHeight
                
                ' 计算剩余高度和每行应分配的高度（仅当总行数大于1时执行）
                If totalRows > 1 Then
                    remainingHeight = masterShape.Height - firstRowHeight
                    rowHeight = remainingHeight / (totalRows - 1)
                    
                    ' 给第2到最后一行分配均等高度
                    For p = 2 To totalRows
                        oShp.Table.Rows(p).Height = rowHeight
                    Next p
                End If
            End If
        Next oShp
    Next oSld
End Sub

关键修改说明 #

1. 新增变量存储总行数、剩余高度和目标行高，逻辑更清晰；
2. 先将表格总高度设为占位符高度，避免行高累加后出现高度偏差；
3. 修正行高计算公式：remainingHeight / (totalRows - 1)，确保剩余空间被所有非第一行均分；
4. 增加判断totalRows > 1，避免表格只有一行时出现除以0的错误。

内容的提问来源于stack exchange，提问作者Oran G. Utan