VBAでPowerPointからExcelにレイアウト通りに出力する

PowerPoint上の全文字列をExcelに出力するPowerPointマクロは作成できたのですが、シェイプのインデックス順に出力してしまいます。

レイアウト通りに貼り付ける際はどう変更すればいいのでしょうか

Excel　VBAでコードを入力しました

こちらのHPを参考にしました
[インストラクターのネタ帳]より
PPTファイル上の全文字列をExcelに出力するPowerPointマクロ
https://www.relief.jp/docs/018395.html

質問者からの補足コメント

• レイアウト通りについてです
  PowerPointに入力した文字列を上から最初に貼り付けるというふうにしたいです

  No.1の回答に寄せられた補足コメントです。 補足日時：2023/07/05 14:00

No.4 回答者： Qchan1962 回答日時： 2023/07/05 19:01

＃１です

Excelで並び替えするのが簡単ですが
PowerPoint　VBAでExcelを操作するのは難しいかも知れませんね

ご質問にある参考サイトのコードで取得しているとの事ですので少し改造して配列でデータと.Top Pointを受け取り.Top Pointで並び替え、Slide番号で並び替えを行い　出力するとSlide番号順で上部にある順になると思います

Sub test_01()
Dim xls As Object 'Excel.Application
Dim sld As Slide
Dim shp As Shape
Dim txt As String
Dim i As Long 'Excelの行番号
Dim n As Long
Set xls = CreateObject("Excel.Application")
With xls
.Visible = True
.workbooks.Add
.Range("A1").Value = "スライド番号"
.Range("B1").Value = "シェイプ名"
.Range("C1").Value = "文字列"
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
n = n + 1
End If
Next shp
Next sld
ReDim Arr(n - 1, 3)
i = 0
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
Arr(i, 0) = sld.SlideNumber
Arr(i, 1) = shp.Name
'垂直タブ・キャリッジリターンをExcelの改行に置換
txt = shp.TextFrame.TextRange.Text
txt = Replace(txt, Chr(11), vbLf)
txt = Replace(txt, vbCr, vbLf)
Arr(i, 2) = txt
Arr(i, 3) = shp.Top * 1 / 72 * 2.54
i = i + 1
End If
Next shp
Next sld
Call bubble_sort(Arr, 3)
Call bubble_sort(Arr, 0)
.Range("A2", .Cells(UBound(Arr, 1) + 2, UBound(Arr, 2))).Value = Arr
End With
Set xls = Nothing

End Sub

Sub bubble_sort(ByRef argAry() As Variant, ByVal keyPos As Long)
Dim vSwap As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
For i = LBound(argAry, 1) To UBound(argAry, 1)
For j = LBound(argAry) To UBound(argAry) - 1
If argAry(j, keyPos) > argAry(j + 1, keyPos) Then
For k = LBound(argAry, 2) To UBound(argAry, 2)
vSwap = argAry(j, k)
argAry(j, k) = argAry(j + 1, k)
argAry(j + 1, k) = vSwap
Next
End If
Next j
Next i
End Sub　

shp.Topは出力していません
ExcelVBAの方が私的には簡単かな

参考サイト
[インストラクターのネタ帳]より
PPTファイル上の全文字列をExcelに出力するPowerPointマクロ
https://www.relief.jp/docs/018395.html

エクセルの神髄 鵜原パソコンソフト研究所
2次元配列の並べ替え
https://excel-ubara.com/excelvba5/EXCELVBA229.html

この回答へのお礼

こちらのコードを使わせていただき、無事反映することができました。わかりにくい説明の仕方で申し訳ありません…
今後の勉学のために使わさせていただきます

お礼日時：2023/07/06 08:35

No.3 回答者： fujillin 回答日時： 2023/07/05 17:28

こんにちは

「レイアウト通り」の意味がいろいろに解釈できるので、考え方をいろいろ・・

◇文字通り「レイアウト通り」にしたい場合
セルに出力するのでは位置指定に無理がありますので、そのままShapeでコピペするのが簡単です。
手操作で言えば、PPTのページで全選択、コピー（Ctrl+A,cTRL+Ｃ)、エクセル上でペースト（Ctrl+V）で行えば、上下左右前後の位置関係もそのままコピペできます。
これと同じことを行えば良いでしょう。

テキストのみを残したいのなら、テキストを含むshapeだけをコピーするか、あるいは、まとめて全部コピペしてしまってから、ご提示のサイトでテキストを拾っているのとは逆に、テキスト以外を削除すれば宜しいでしょう。


＞文字列を上から最初に貼り付けるというふうにしたいです
◇表示上の上下方向（＝前面・背面ではない）の順序ををセルの行に反映して貼り付けたい場合
レイアウトはそのままではなく、上記の順序だけを守りたいというのであれば、PPTのShapeのTopプロパティで文書ボックスの上下方向の位置を取得できます。
（上端の位置になるので、中央の位置で判断するのなら「+.Height/2」した値で評価すれば良いでしょう。）
https://learn.microsoft.com/ja-jp/office/vba/api …

このTopの値でソートして、順にエクセルに書き出せば良いのですが、VBAでのソートは面倒なので・・
例えば、Ｄ列にTopの値を併せて書き出すようにしておいて、1ページ分の出力が終わったら、Ｄ列をキーにエクセルのシート機能でソートすればTopの順になります。
並べ替えが終わったら、Ｄ列の値は削除すれば良いでしょう。


＞文字列を上から最初に貼り付けるというふうにしたいです
◇表示上の前後関係（＝上下ではない）の順序ををセルの行順に反映して貼り付けたい場合
PPT上で、文字列を重ねて前後に表示していることは少ないと思いますので、このケースはご質問の趣旨ではないのかとも思いますが・・・

PPTの Shape のインデックスは、通常、背面にあるものから順になるようになっています。
ですので、普通にループすると背面にあるものから順に処理されます。
これを、前面からの順にしたいのであれば、単純に順序を逆転すればよいですね。
　For Each ～～
とする代わりに
　For i = shapes.Count To 1 Step -1
のようなループにして、shapes(i)に対して処理すれば、逆順にすることが可能です。
別法として、通常のループで書き出してから、エクセル上で逆順に並び替えるいう方法も考えられますけれど・・

No.2 回答者： kantansi 回答日時： 2023/07/05 15:26

PowerPoint上の全文字列をExcelに出力する際に、シェイプのインデックス順ではなく、レイアウト通りに貼り付けるためには、マクロのコードを一部変更する必要があります。

以下に具体的な手順を示します。

マクロコード内の「For Each shp In ActivePresentation.Slides(i).Shapes」という行を、「For Each shp In ActivePresentation.Slides(i).Shapes.Range(Array(ppPlaceholder)).Placeholders」と置き換えます。これにより、プレースホルダーのみが対象となります。

コード内の「With ws.Cells(R, 1)」という行を、「With ws.Cells(ActivePresentation.Slides(i).Shapes.Placeholders(1).Top, ActivePresentation.Slides(i).Shapes.Placeholders(1).Left)」に変更します。これにより、プレースホルダーの位置情報を取得してセルに書き込むことができます。

コード内の「R = R + 1」を削除します。これにより、新しいセルに移動せずに次のプレースホルダーにデータを書き込むことができます。

以上の変更を行うことで、プレースホルダーのレイアウト通りに文字列をExcelに出力することができます。ただし、この方法はプレースホルダーを基準にしているため、プレースホルダーがない場合やレイアウトが複雑な場合にはうまく機能しない可能性があります。必要に応じてコードを修正してください。

なお、上記の手順は参考サイトのコードをベースにしたものであり、正確な動作確認は行っておりません。変更を加える際には注意して実施してください。

No.1 回答者： Qchan1962 回答日時： 2023/07/05 13:15

＞レイアウト通りに貼り付ける際はどう変更すればいいのでしょうか

ご質問の回答にはならないかも知れませんが
＞レイアウト通り　　とは？　Z方向　N方向？

インデックス順でも取得できているのなら　Excel側でShape名などを対象に並び替え処理を行う方が簡単かもしれませんね
配置とShape名の関連が無いと意味ないですかね

そのような場合は少し工夫をして
取得時にSlide番号とShape.Topを同時に取得してその列で並び替え処理などが簡単な方法だと思います（上からになってしまいますがZ）
For Each shp In sld.Shapes
＝shp.Top　

PowerPoint上のShape名、Shapeインデックスを予め順序良く変えて置くとか・・・もあるけれどどうでしょう