Question

我正在尝试整合一些代码，这些代码合并了上面一行中存在重复内容的单元格。代码可以工作，但是一旦我到达第三行，我会收到一条错误消息：

单元格（未知编号）：无效请求。无法合并不同大小的单元格。

当我回到UI时，我可以手动执行合并，所以我不相信单元格大小不同。所以我认为这是我的代码问题或VBA .Merge方法的限制？

代码低于

Sub testMergeDuplicateCells()
Dim oSl As Slide
Dim oSh As Shape
Dim k As Long


slideCount = ActivePresentation.Slides.Count
For k = 3 To (slideCount)
Set oSl = ActivePresentation.Slides(k)

'Start looping through shapes
       For Each oSh In oSl.Shapes
'Now deal with text that is in a table
            If oSh.HasTable Then
                Dim x As Long, z As Long, y As Long
                Dim oText As TextRange
                Dim counter As Long

                counter = 0
                    For x = 17 To oSh.Table.Rows.Count 'will always start on 17th row
                        For z = 1 To oSh.Table.Columns.Count
                        Set oText = oSh.Table.Cell(x, z).Shape.TextFrame.TextRange

                         y = x - 1
                        Set pText = oSh.Table.Cell(y, z).Shape.TextFrame.TextRange

                              If pText = oText Then
                                    With oSh.Table 
                                        .Cell(x + counter, z).Shape.TextFrame.TextRange.Delete
                                        .Cell(y, z).Merge MergeTo:=.Cell(x, z)
                                    End With 
                                    counter = counter + 1
                                End If


                        Next z
                    Next x
        End If

    Next oSh

Next k

End Sub

Answer 1

我发现了这个问题并提出了一个非常优雅的解决方案（目前）。

首先要意识到细胞的实际尺寸是什么。显然，当PPT进行单元格合并时，它会在合并之前保留基础坐标。因此，在将Cell（1,1）合并到Cell（2,1）之后，细胞在视觉上显示为一个细胞，但保留了（1,1）和（2,1）的坐标。

这个实用程序帮助我理解了我的表的实际底层构造，通过在UI中选择一个单元格并让实用程序为我提供完整的维度。

Sub MergeDuplicateCells()
Dim oSl As Slide
Dim oSh As Shape
Dim k As Long

slideCount = ActivePresentation.Slides.Count
For k = 3 To (slideCount)
Set oSl = ActivePresentation.Slides(k)

'Start looping through shapes
       For Each oSh In oSl.Shapes
'Now deal with text that is in a table
            If oSh.HasTable Then
                Dim x As Long, z As Long, y As Long
                Dim oText As TextRange

                        For z = 1 To oSh.Table.Columns.Count
                        'inelegant solution of skipping the loop to the last column
                        'to prevent looping over same merged cell
                        If z = 3 Or z = 6 Or z = 8 Or z = 16 Then
                        For x = 17 To oSh.Table.Rows.Count
                        Set oText = Nothing
                        Set pText = Nothing
                        Set oText = oSh.Table.Cell(x, z).Shape.TextFrame.TextRange

                        If x < oSh.Table.Rows.Count Then

                        y = x + 1
                        Set pText = oSh.Table.Cell(y, z).Shape.TextFrame.TextRange

                              If pText = oText And Not pText = "" Then
                                    With oSh.Table
                                        Debug.Print "Page " + CStr(k) + "Merge Row " + CStr(x) + " Col " + CStr(z) + " with " + "Row " + CStr(y) + " Col " + CStr(z)
                                        .Cell(y, z).Shape.TextFrame.TextRange.Delete
                                        .Cell(x, z).Merge MergeTo:=.Cell(y, z)
                                    End With

                                End If
                        End If

                        Next x
                        End If
                    Next z
        End If
    Next oSh
Next k

End Sub

然后我放入了一个相当优雅的If语句，让我的循环跳转到属于合并单元格集合的最后一列，因此仅删除和合并语句只发生一次。当（正如史蒂夫在上面指出的那样）循环再次查看同一个单元格并将其解释为在两个单元格中具有重复值时，即使它是合并单元格中的一个值，也会引入错误。

{{1}}

vba powerpoint合并循环中的单元格

1 个答案: