パワーポイントのプレゼンテーションに挿入されている表をVBAで処理する場合について

Question

お疲れ様です。

powerpointのvbaで表を対象とした処理で結合セルを含んでいても見た目上のセル全てのみについて処理する方法はないでしょうか。

powerpointのvbaで表を対象とした処理を実行する際についてです。

パワーポイントのプレゼンテーションに挿入されている表の各セルの値についてvbaで値の一致、不一致処理を行うと下記のような処理結果となりました。

１　表は結合されているセルの有無に関わらず列×行のセル数として認識される
２　結合されているセルについて値を参照すると見えていない結合前のセル全てに結合後のセルの値が入っている。

上記のような動作結果なので見た目上のセル数とvbaで実行した際のセル数が一致しないのでvbaの実行結果では一致数、不一致数が見た目上よりも多くなってしまいます。
例　列３×行３の表があり、行２の３列が結合されていてもvba上での表のセル数は３×３の９つと認識されている。

表の全てのセルを参照させるのはTable.Rowsのfor eachの中にTable.Columnsのfor eachを入れ子にして実行しています。

Accepted Answer

きれいに取得する方法が見つからなかったので、無理やり作ってみました。


```VBA
Function TableCells(tbl As Table) As Collection
    
    Dim dic 'As New Scripting.Dictionary
    Set dic = CreateObject("Scripting.Dictionary")
    
    Set dic("1 1") =  tbl.Rows(1).Cells(1)
    
    Dim i, j, c
    For i = 1 To tbl.Rows.Count
    For j = 1 To tbl.Columns.Count
        c = i & " " & j
        If tbl.Rows(i).Cells(j).Selected = False Then
            Set dic(c) = tbl.Rows(i).Cells(j)
        End If
        tbl.Rows(i).Cells(j).Select
    Next j, i
    
    For j = 1 To tbl.Columns.Count
    For i = 1 To tbl.Rows.Count
        c = i & " " & j
        If dic.Exists(c) And tbl.Rows(i).Cells(j).Selected Then
            dic.Remove i & " " & j
        End If
        tbl.Rows(i).Cells(j).Select
    Next i, j

    Set TableCells = New Collection
    For Each c In dic
        TableCells.Add dic(c), c
    Next

End Function
```
```VBA
Sub sample()

    Dim shp As Shape
    Set shp = ActivePresentation.Slides(1).Shapes(1)
    Dim tbl As Table
    Set tbl = shp.Table

    Dim coll As Collection
    Set coll = TableCells(tbl)

    Debug.Print coll.Count
    
    Dim c As Cell
    For Each c In coll
        Debug.Print c.Shape.TextFrame2.TextRange.Text
    Next

End Sub
```
---
＜追記＞
Excelから呼び出すのも同じ感じで行けると思います。
ただ、以下はPowerPointが既に起動している前提で書いているので、
そうでない場合はもう一工夫いるのかもしれません。

```VBA
Sub ExcelVBASample()

    Dim ppap As PowerPoint.Application
    Set ppap = GetObject(, "Powerpoint.Application")

    Dim shp As PowerPoint.Shape
    Set shp = ppap.ActivePresentation.Slides(1).Shapes(1)

    Dim tbl As PowerPoint.Table
    Set tbl = shp.Table

    Dim coll As Collection
    Set coll = TableCells(tbl)

    Debug.Print coll.Count

    Dim c As Cell
    For Each c In coll
        Debug.Print c.Shape.TextFrame2.TextRange.Text
    Next

End Sub

```