やりたいこと
1.PowerPointからExcelへシェイプの一覧を書き出す(今回はExcelから取りに行くけど)
2.ユーザーが手動操作でシェイプの名前を変更する
3.変更した値をExcelからPowerPointへ反映させる、更新する
www.youtube.com
https://www.youtube.com/watch?v=o0PVL1v27Ts
目次
00:00 やりたいこと あいさつ
01:12 1.PowerPointからExcelへシェイプの一覧を書き出す(今回はExcelから取りに行くけど)
02:39 1.1 ppシェイプの値をエクセルへ 実行結果を先に見せる
04:48 1.1.1 あれれ？名前が違うよ・・
08:23 1.1.3 ついでに続けると、コピペ時に同じ名前と違う名前になるパターンがあったり？
13:06 1.2 シェイプの情報取得 ソースコードのポイントを解説
24:53 2.ユーザーが手動操作でシェイプの名前を変更する
28:08 3.変更した値をExcelからPowerPointへ反映させる、更新する
3.1 エクセルから名前Nameプロパティをセットする
30:08 3.2 Nameプロパティをセットする ソースコードのポイントを解説
34:56 IDプロパティを見て目的のシェイプを探す
38:38 図の名前を変更してみる 使用方法を再度実演する
42:03 4.マクロの設置方法
4.1 新規のExcelファイルを作成します
43:17 4.2 Excelファイルを開き 1行目の調整
4.2.1 1行目の高さを増やします。
4.2.2 先頭行を固定
45:19 4.2.3 挿入 図形から 起動用の図形を入れます
48:17 4.3 Webからソースコードをコピーします
4.4 起動用の図形 矢印を右クリックしてマクロの登録を選択します
4.4.1 あわてず、新規作成を押します
4.4.2 マクロのコード編集画面が表示されるので、カーソルを移動させ貼り付けます
4.4.3 貼り付け確認後、Excelシートへ戻ります
53:14 4.4.4 再度 図形をクリックしてマクロの登録を選択します
4.4.5 書き込み用 もう一つも同様に右クリックマクロの登録
4.5 マクロを設置後、テストします
57:12 4.6 保存方法 警告メッセージがでるので いいえ を押します
4.6.1 一つ下の マクロ有効ブックを選択します。
4.6.2 再度起動して、チェック
01:00:08 5.終わりの挨拶
5.1 やりたいことを勘違いして、間違えてしまった、怒られるぞ・・・
01:03:34 5.2 D列の変更を無視して、IDで名前と位置、サイズを変更する
01:04:36 サンプルのプレゼン リモートワークの服装を紹介
01:05:51 修正方法を見せる 5.3 位置と高さを変える .Width .Heightを設定
01:13:25 Excelからパワポ画像の位置とサイズを一覧で設定するコードの実行
01:23:04 5.4 shp.Typeで種類がわかる
01:26:51 PowerPointスライド1ページに複数の画像が存在する場合のテスト実演
01:31:45 スライド内の画像位置を交換したい時
01:34:00 テキストボックスの位置を移動させたい時 テストする
#ExcelVBA #PowerPointVBA #マクロ #シェイプ #Shape #デバッグ
1.PowerPointからExcelへシェイプの一覧を書き出す(今回はExcelから取りに行くけど)
1.1 ppシェイプの値をエクセルへ 実行結果を先に見せる
ホーム 配置 オブジェクトの選択と表示
ここの名前とExcelに取り込まれた名前を確認する
1.1.1 あれれ？名前が違うよ・・
https://www.youtube.com/watch?v=o0PVL1v27Ts&t=288
PowerPointの元データ
正方形/長方形 4
二等辺三角形 3
楕円 2
タイトル 1
Excel取り込み
Title 1
Oval 2
Isosceles Triangle 3
Rectangle 4
※順番が違うのは、いいとして、
．Nameのプロパティが間違ってない？
1.1.3 ついでに続けると、コピペ時に同じ名前と違う名前になるパターンがあったり？
https://www.youtube.com/watch?v=o0PVL1v27Ts&t=503
蛇足ついでに、コピペ時に
同じ名前でコピペされたりする。
Sheet1(2)や
ファイル名だと、
新規 Microsoft Excel ワークシート - コピー.xlsx
新規 Microsoft Excel ワークシート - コピー (2).xlsx
とか、(2)が付いたりするんだけど、
同じ名前のコピーと貼り付けをやってみる。
なので、プロパティNameが違うところを見ている説？を見かけたりする。
名前と表題、表示名の違い？
※※ここは、気になるところだけど、今回は、掘り下げないで解説を続けます
視聴者:「逃げんなよ...」
1.2 ソースコードのポイントを解説
疑問が残りつつ、マクロの説明に入ります。
https://www.youtube.com/watch?v=o0PVL1v27Ts&t=786
と言っても、
スライドのループ
For p = 1 To ppApp.ActivePresentation.Slides.Count 'スライド数ループ pページ
と
'pページのスライド内のシェイプを探る
For Each objShape In ppApp.ActivePresentation.Slides(p).Shapes
の二重ループで回して、
プロパティ
Cells(y, "B") = objShape.ID 'IDで今回、区別したいので※24/03/02追加
Cells(y, "C") = objShape.Name 'オブジェクトの名前
※D列は入力用に空白にして
Cells(y, "E") = objShape.Left '位置 左上の左 判断材料
Cells(y, "F") = objShape.Top '位置 左上の縦
Cells(y, "G") = Left(objShape.TextFrame.TextRange.Text, 10) 'テキスト
をセットしただけだったり・・・
'起動済みの既存 パワーポイント からシェイプの情報を取得する 'スライド内のShapes から Id,Name,Left,Top と テキスト先頭から10文字を取り出す 'アクティブシートにパワポの値を取得 ※勝手に全クリアして書き込むので※※注意 '今回、名前変更に使いたかったのでID,Nameと判断材料でLeft,Top,Textを取得 Sub test20240302_01ppのシェイプの値を取得() Dim ppApp As Object 'As PowerPoint.Application Set ppApp = Nothing 'エラーチェックのため初期化 On Error Resume Next '取得エラー時に次へ行く Set ppApp = GetObject(, "PowerPoint.Application") On Error GoTo 0 'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意 If ppApp Is Nothing Then MsgBox "パワポを取得できません。プレゼンスライドを開いてから、再テストしてね" Exit Sub End If Cells.ClearContents 'アクティブシートを※勝手に全クリアして書き込むので※※注意 Range("A1").Select '見出しを書き込む Range("A1") = "Page番号" Range("B1") = "ID" Range("C1") = "名前 Shape.Name" Range("D1") = "※更新する名前" '※今回名前を変更したかったので、隣のD列を使う Range("E1") = "左位置.Left" '位置等で絞り込む？ Range("F1") = "上位置.Top" Range("G1") = "テキスト 先頭から10文字" 'テキストがあれば判断時便利かな？ Dim p As Integer, y As Integer 'pページ、y行 Dim objShape As Object 'As PowerPoint.Shape 'パワポのシェイプ、テキスト、図形ほか y = 2 '取得したテキストデータを二行目から書きたいので For p = 1 To ppApp.ActivePresentation.Slides.Count 'スライド数ループ pページ 'pページのスライド内のシェイプを探る For Each objShape In ppApp.ActivePresentation.Slides(p).Shapes Cells(y, "A") = p 'スライド番号(ページ番号) Cells(y, "B") = objShape.ID 'IDで今回、区別したいので※24/03/02追加 Cells(y, "C") = objShape.Name 'オブジェクトの名前 Cells(y, "D") = "" '↑を変更したい名前をD列に書き込むため、初期値は空白 Cells(y, "E") = objShape.Left '位置 左上の左 判断材料 Cells(y, "F") = objShape.Top '位置 左上の縦 'オブジェクトがテキストを持っているか？チェックしてからセット If objShape.HasTextFrame = msoTrue Then 'テキストフレームあり If objShape.TextFrame.HasText = msoTrue Then 'テキスト範囲あり Cells(y, "G") = Left(objShape.TextFrame.TextRange.Text, 10) 'G列へテキストを10文字だけ書き込む↑,99文字など好みの文字で End If End If y = y + 1 'セットする行を次へ Next Next MsgBox "処理終了、名前を確認・修正してください" End Sub
2.ユーザーが手動操作でシェイプの名前を変更する
実際に、D列に変更したい名前を書き込み、修正します
テストデータをセット後↓で実行する
3.変更した値をExcelからPowerPointへ反映させる、更新する
3.1 エクセルから名前をセットする
マクロを実行して、
実行結果、変更結果を先に見せる
3.2 ソースコードのポイントを解説
逆の処理なので、ポイントは
前回まで、
ExcelからパワポへSUM計算結果とテキストを指定位置に代入・転記する PowerPointのスライドを開き 指定ページに値と文字列をセットする マクロ VBA
https://www.youtube.com/live/VUw8a-xW55w?si=NASKrUkiOkXnhDH-&t=300
で、
ページ数をオブジェクト名がわかれば、セットできる
と豪語して、使ってましたが、
'pページのスライド内のシェイプ A列のページ と B列の名前を使う
Set ppShape = ppセット先.Slides(p).Shapes(strShpName)
↑みたいに、pページの名前でシェイプを確定させていた
現在、
名前が同じ可能性に気が付いたので、考慮して、
IDを探して、PページのID=99でシェイプを指定しました。
※このIDも、連番ではないし、Indexがありそうなんだけど・・・
ぼやいてないで、ソースのポイントを解説すると、
https://www.youtube.com/watch?v=o0PVL1v27Ts&t=1808
↑みたいな感じです。
'Excel D列に値があったら、起動済みのパワーポイントへD列の名前をセットする 'A列:Page,B列:Idを使用して、シェイプを探し、 'NameプロパティにD列の値をセットする Sub test20240302_02D列の値でppシェイプの名前を書き換える() Dim ppApp As Object 'As PowerPoint.Application Set ppApp = Nothing 'エラーチェックのため初期化 On Error Resume Next '取得エラー時に次へ行く Set ppApp = GetObject(, "PowerPoint.Application") On Error GoTo 0 'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意 If ppApp Is Nothing Then MsgBox "パワポを取得できません。プレゼンスライドを開いてから、再テストしてね" Exit Sub End If Dim p As Integer, y As Integer 'pページ、y行 Dim ShpWORK As Object 'As PowerPoint.Shape ループでIDを探すときに使う Dim objShape As Object 'As PowerPoint.Shape 'パワポのシェイプ、テキスト、図形ほか '二行目からB列IDがなくなるまでループする For y = 2 To 9999 '9999までと言いつつ↓で終了チェック、おいおい・・・ If Trim("" & Cells(y, "B")) = "" Then Exit For 'B列に値が無かったら、ループを抜ける If Trim("" & Cells(y, "D")) <> "" Then 'D列に変更用の名前がある時だけセットする Set objShape = Nothing 'セット先のシェイプを初期化 'pページのスライド内のシェイプをIDで探して値をセットする p = Cells(y, "A") 'スライド番号(ページ番号) For Each ShpWORK In ppApp.ActivePresentation.Slides(p).Shapes 'ページ内の全てをあさる 'IDが一致するか、チェックする If ShpWORK.ID = Cells(y, "B") Then 'B列のIDと比較 Set objShape = ShpWORK '見つけたので、オブジェクトをセットする Exit For '探すループを抜ける End If Next 'IDを探す↑ループ 'ID有無の判断 If objShape Is Nothing Then '見つからないとき MsgBox p & "ページのID=" & Cells(y, "B") & "が見つかりません" 'Exit Sub '保留 Else '名前を変更する objShape.Name = Trim(Cells(y, "D")) 'D列の値をオブジェクトの名前にする End If End If 'D列に名前がある時だけ↑処理 Next y '行の↑ループ MsgBox "処理終了、セットされた名前を確認してください" End Sub
4.マクロの設置方法
https://www.youtube.com/watch?v=o0PVL1v27Ts&t=2523
4.1 新規のExcelファイルを作成します
右クリックでもいいし、新規作成でもいいし。
4.2 Excelファイルを開き 1行目の調整
新規の真っ白なシートが開かれます。
4.2.1 1行目の高さを増やします。
コマンド起動用の図形を設置したいので、1行目の高さを増やします。
4.2.2 先頭行を固定
表示 ウインドウ枠の固定
先頭行を固定 すると、便利です
4.2.3 挿入 図形から 起動用の図形を入れます
ここでは、マクロを起動する図形を先に挿入します。
←矢印 と 矢印→にしました。
パワポから取得 と パワポにセット
の二つの図形を挿入します
4.3 Webからソースコードをコピーします
ソースコードをコピーします。
4.4 起動用の図形 矢印を右クリックしてマクロの登録を選択します
4.4.1 あわてず、新規作成を押します
新規作成を押します
すると、画面が変わって、↓コードの入力に切り替わります。
4.4.2 マクロのコード編集画面が表示されるので、カーソルを移動させ貼り付けます
※必ず、カーソルを移動すること
4.4.3 貼り付け確認後、Excelシートへ戻ります
4.4.4 再度 図形をクリックしてマクロの登録を選択します
ここで、
test20240302_01ppのシェイプの値を取得
を選択して、OKを押して登録します。
4.4.5 書き込み用 もう一つも同様に右クリックマクロの登録
ここで、
Sub test20240302_02D列の値でppシェイプの名前を書き換える
を選択して、登録します。
4.5 テストします
4.6 保存方法 警告メッセージがでるので いいえ を押します
テスト終了後、保存します。※次回コードの貼り付けからやらなくて済むように
マクロ付きのブックにしていないので、
警告メッセージがでます。
ここで、 いいえ にして、マクロ付きのブックにして保存します。
4.6.1 一つ下の マクロ有効ブックを選択します。
マクロ有効ブック xlsm を選択します
4.6.2 再度起動して、チェック
警告レベルにもよるけど、黄色いメッセージがでたら、有効にする
5.終わりの挨拶
これで、できたかなぁ・・・
作業、処理のヒントとなれば幸いです。
で、終われないのが、
私が
三流プログラマーの理解力不足の派遣のおっさん・・と言われる理由。
https://www.youtube.com/watch?v=o0PVL1v27Ts&t=3608
5.1 やりたいことを勘違いして、間違えてしまった、怒られるぞ・・・
キッカケにもどる。
https://www.youtube.com/watch?v=zYczLG7wF9E
に対して、下記の修正依頼をいただく。
会社でパワーポイントの教材資料を100枚の言語違い3部を作成しましたが、
元々の資料がExcelで作成したテキストや画像データを貼り付けて作成しました。
テキストの位置やサイズがバラバラで、一個一個位置やサイズを手動で変更していましたが、
「Excelを使いパワポの図形やテキストを大量に移動したい 位置LeftとTopを取得値を変更後セッ
トして移動する ExcelからPowerPoint操作・・・」
のYouTubeを見てびっくりです。
一気に出来るではないですか！！！！！
サンプルを参考にさせて頂き、一気に高さと幅のサイズを変更ところまでできましたが、
Shape.Nameが元々バラバラのため一気に変更する事ができません。A列に元のShape.Nameで、
B列に新しいShape.Nameを並べて一気に変更する様な方法を教えて頂けませんでしょうか。
VBAの知識が殆どありません。
無理を言った大変申し訳ありませんが、宜しくお願いします。
＞A列に元のShape.Nameで、B列に新しいShape.Nameを並べて一気に変更する様な方法
少し、探ってみます。
あまり、期待しないで下さいね
※並行して、検索やGPTに聞いたり、調べてみてください。
少々、お待ちを。 三流プログラマー Ken3
あっ、
ヤバイ、作成したけど、勘違いしたかも・・・・
＞A列に元のShape.Nameで、B列に新しいShape.Nameを並べて一気に変更する様な方法
で、
脳内が、名前の変更になってしまい、勘違いのコードを書いてしまった・・・
やりたいことは、
＞テキストの位置やサイズがバラバラで、一個一個位置やサイズを手動で変更していましたが、
＞「Excelを使いパワポの図形やテキストを大量に移動したい 位置LeftとTopを取得値を変更後
＞セットして移動する ExcelからPowerPoint操作・・・」
＞のYouTubeを見てびっくりです。
＞一気に出来るではないですか！！！！！
＞サンプルを参考にさせて頂き、一気に高さと幅のサイズを変更ところまでできましたが、
＞Shape.Nameが元々バラバラのため一気に変更する事ができません。
もしかしなくても、名前がバラバラのシェイプの位置を変更したい・・・って感じだったな。
まずいなぁ・・・
5.2 D列の変更を無視して、IDで名前と位置、サイズを変更する
↑やりたいのは、コレですね。
コードの設置までやって、
やっと、間違いに気が付いた。反省・・・
5.3 位置と高さを変える .Width .Heightを設定
https://www.youtube.com/watch?v=o0PVL1v27Ts&t=3951
'幅と高さ 24/03/02
Range("G1") = "幅 .Width" '位置等で絞り込む？
Range("H1") = "高さ .Height"
Range("I1") = "テキスト 先頭から10文字" 'テキストがあれば判断時便利かな？
5.4 shp.Typeで種類がわかる
https://www.youtube.com/watch?v=o0PVL1v27Ts&t=4984
解決のヒントとなれば幸いです。
似た処理の過去動画の紹介:
Excelを使いパワポの図形やテキストを大量に移動したい 位置LeftとTopを取得 値を変更後セットして移動する ExcelからPowerPoint操作 VBA
https://www.youtube.com/watch?v=zYczLG7wF9E
や
マクロ パワポのテキストをExcelへ書き出す 起動済みの既存スライド Shapes から テキスト取得 デバッグ方法 マクロの作り方・使い方
https://www.youtube.com/watch?v=FZovWjt0xtQ
を
参考にして、ソースを作成してみました。
