VBA Powerpoint verschmelzen Zellen in Schleife

Question

Ich versuche, einige Code zusammenführen, die Zellen zusammenführt, wo doppelte Inhalte in der Zeile oben ist. Der Code funktioniert, aber sobald ich in die dritte Zeile komme, bekomme ich einen Fehler, der sagt:

Zelle (unbekannte Nummer): Ungültige Anfrage. Es können keine Zellen unterschiedlicher Größe zusammengeführt werden.

Wenn ich zurück zur Benutzeroberfläche gehe, kann ich die Zusammenführung manuell durchführen, also glaube ich nicht, dass die Zellen unterschiedliche Größen haben. Also ich denke, es ist ein Problem mit meinem Code oder eine Einschränkung der VBA. Merge-Methode?

-Code ist unter

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

ich das Problem gefunden und kam in-eleganten Lösung mit einer sehr hoch (bis jetzt).

Zuerst wurde realisiert, was die tatsächlichen Abmessungen der Zelle waren. Offensichtlich behält PPT, wenn eine Zelle zusammengeführt wird, die zugrunde liegenden Koordinaten vor der Zusammenführung bei. Nachdem ich Cell (1,1) mit Cell (2,1) verbunden habe, erscheint die Zelle visuell als eine Zelle, behält aber die Koordinaten von (1,1) und (2,1).

Dieses Dienstprogramm half mir zu verstehen, was das eigentliche zugrunde liegende Konstrukt meiner Tabelle war, indem Sie eine Zelle in der Benutzeroberfläche auswählen und das Dienstprogramm mir die vollen Dimensionen geben.

Sub TableTest() 

Dim x As Long 
Dim y As Long 
Dim oSh As Shape 

Set oSh = ActiveWindow.Selection.ShapeRange(1) 

With oSh.Table 
For x = 1 To .Rows.Count 
For y = 1 To .Columns.Count 
If .Cell(x, y).Selected Then 
Debug.Print "Row " + CStr(x) + " Col " + CStr(y) 
End If 
Next 
Next 
End With 

End Sub 

ich dann in-elegant in einem eher setzen If-Anweisung meine Schleife zu haben, um die letzte Spalte überspringt, was geschah nur einmal Teil des Satzes von verbundenen Zellen, so dass die Löschen und Zusammenführen nur Anweisung war. Der Fehler wurde eingeführt, als die Schleife (wie Steve weiter oben ausgeführt hat) erneut dieselbe Zelle betrachtete und sie als doppelten Wert für zwei Zellen interpretierte, obwohl es sich um einen Wert in einer verbundenen Zelle handelte.

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