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

Question

お疲れ様です。

powerpointのvbaで表を対象とした処理で結合セルを含んでいても見た目上のセル全てのみについて処理する方法はないでしょうか。

powerpointのvbaで表を対象とした処理を実行する際についてです。

パワーポイントのプレゼンテーションに挿入されている表の各セルの値についてvbaで値の一致、不一致処理を行うと下記のような処理結果となりました。

１　表は結合されているセルの有無に関わらず列×行のセル数として認識される
２　結合されているセルについて値を参照すると見えていない結合前のセル全てに結合後のセルの値が入っている。

上記のような動作結果なので見た目上のセル数とvbaで実行した際のセル数が一致しないのでvbaの実行結果では一致数、不一致数が見た目上よりも多くなってしまいます。
例　列３×行３の表があり、行２の３列が結合されていてもvba上での表のセル数は３×３の９つと認識されている。

表の全てのセルを参照させるのはTable.Rowsのfor eachの中にTable.Columnsのfor eachを入れ子にして実行しています。

Comments

[1T2R3M4]

質問は何でしょうか。

Answer 1

きれいに取得する方法が見つからなかったので、無理やり作ってみました。

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

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が既に起動している前提で書いているので、
そうでない場合はもう一工夫いるのかもしれません。

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

Comments

[fzrtera]

ありがとうございます。
動作の仕組み的にはパワポ上でのセル数全てに対してSelected?を調べて有効なセルかどうかを配列に格納、有効なセルが格納された配列を配列数分参照ということでしょうか。

別件ですが問題のあるコードを貼り付けて更新したと思っていたのですが反映されていませんでした。すみませんでした。

[jinoji]

そうですね。
一つ手前のセルをセレクトしてから、次のセルのセレクト状態を確認する。
もし次のセルもSelectedになっているなら、それは前のセルと結合されているからだ、という理屈で
全部のセルを順番にチェックしていく感じです。それを、横方向と縦方向で確認しています。

[fzrtera]

ありがとうございます。
excelからパワーポイントを参照させる処理でも動作させることは難しいでしょうか。
試してみたのですがselectの状態取得がexcelからはうまく行えませんでした。

[fzrtera]

ありがとうございました。
ろExcelでも正しく動作しました。
また、参照設定無しで動作させたかったのでとりあえずエラーとなった宣言を全てobjectにしてみたところExcelでも正しく動作しました。

ご対応いただきありがとうございました。