vba powerpoint合併循環中的單元格

我正試圖將合併單元格的位置在上面一行中有重複內容的代碼放在一起。該代碼有效，但一旦我到達第三行，我得到一個錯誤，說：vba powerpoint合併循環中的單元格

單元（未知數）：無效請求。無法合併不同大小的單元格。

當我回到用戶界面時，我可以手動執行合併，因此我不相信單元格大小不同。所以我認爲這是我的代碼或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

來源

2016-04-01 Stewart Whitman

查看合併前兩個單元格之前和之後的單元格數。這可能是現在合併的細胞計算爲單個細胞而不是兩個細胞，這會將計數器索引放入細胞集合中。作爲測試，您可以嘗試如下所示：每次找到兩個相同的單元格進行合併時，合併它們，然後從頭開始再次處理該行。 –

這絕對是問題的一部分，另一個問題是單元格是一個更大的表格的一部分，一些單元格合併已經完成。所以視覺上看起來像一個細胞，實際上是2,3或8列合併在一起。它並不優雅，但我必須通過循環合併單元格的行和最後一列來循環遍歷額外的迭代。我寫了一個額外的Sub來告訴我合併單元格的尺寸是多少。在下面的答案中發佈。 –

我發現這個問題，並具有非常的，優雅的解決方案提出了（現在）。

首先是實現細胞的實際尺寸。顯然，當PPT進行單元合併時，它會在合併之前保留底層座標。所以在將Cell（1,1）合併到Cell（2,1）之後，單元看起來像是一個單元格，但保留了（1,1）和（2,1）的座標。

這個實用程序幫助我瞭解了我的表的實際底層結構，通過在UI中選擇一個單元並讓該實用程序爲我提供了完整的維度。

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

然後我把在一個相當的優雅。如果語句有我的循環跳到最後一列是一套合併單元格的一部分，所以刪除和合並只有語句只發生過一次。當（如Steve指出的那樣）引入錯誤時，循環再次查看同一個單元格，並將其解釋爲跨兩個單元格具有重複值，即使它是合併單元格中的一個值。

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

來源

2016-04-03 14:17:50

謝謝你......我確定它會在某個時候保存我的皮膚。 –

vba powerpoint合併循環中的單元格

回答

相關問題