A列の値をグループにして値をテンプレートのパワポへセット
セット後jpgファイルを作成しテンプレを閉じる
www.youtube.com
https://www.youtube.com/watch?v=mjnqMrxk0qM
目次
00:00 1.仕様の説明 と 実行結果
02:12 2.テンプレートの作成
03:53 テキストと図形をグループ化して明細を作る
10:02 3.ExcelからPowerPointテンプレにデータを流し込む
11:12 3.2 A列の値が変化するまで、データをセットする
11:59 3.3 グループが変わった時の処理
13:22 3.4 明細にExcelデータをセットする
16:17 3.5 改ページのチェック
21:09 3.6 後始末
21:35 再度ポイントを解説
1.仕様の説明
仕様
A列の値、日付をグループ化のキーにして、
事前に用意されたパワーポイントのテンプレートに値をセットする
グループは５行がMAXです。
A列...E列
日付 会場名 ... 主催者
8/1 XXXホール ... X株式会社
8/1 XXX体育館 ... Y株式会社
8/1 XXXビル2F ... Z株式会社
8/2 XXXホール ... 有限会社A
複数明細をパワポ1ページにセットするイメージです
右上にグループの値(日付)を一つだけセットします。
テンプレートに値をセット後、jpgファイルを作成
ファイル名は月日と曜日で作成する。08/01(火)※スラッシュは全角／にしないとダメかな
2.テンプレートの作成
データを受け取る 枠を作成する
2.1 テキストボックスの名前をExcelの見出しと合わせる。
テキストボックス 99 から変更する
2.2 四角やライン、線の図形を作成する
行区切りのライン線
や
四角で□のチェック入れる※手作業の枠を作成する
2.3 1行分のデータをグループ化する
１行分のデータを管理しやすいようにグループ化する
2.4 データをコピーして、５行作成する
2.5 グループに名前 明細1～5 をつける
明細1
・
・
明細5
1～5は、プログラムで使うので半角で入力してください。
※全角漢字で名前を付けているので、半角の数字に注意
2.6 右上にグループの日付を表示する枠を作成する
右上にテキストボックスを作成する
名前は、 右上グループ と付けます。※なんでもいいけど、あとでプログラムから使うので
2.7 名前を付けて保存する
ここでは、
ひな型0717と名前を付けて保存しました。
テンプレXXXでもいいし、好きな名前、じゃなかった、わかりやすい名前を付けてください。
この名前・テンプレをエクセルで開きます。
3.ExcelからPowerPointテンプレにデータを流し込む
3.1 テンプレートを開く
'ひな型ファイルを開く Dim strPPFName As String strPPFName = ActiveWorkbook.Path & "\ひな型0717.pptx" '※Excelと同じ場所を開く Set ppひな型 = ppApp.Presentations.Open(strPPFName, msoTrue) 'リードオンリーで開く
3.2 A列の値が変化するまで、データをセットする
'A列が存在する間ループする y = 2 'A2から始めたいので 2 PageCODE = "初回に改ページしてねの意味を込めて長文" '本当はPageCODE ="" などで初期化 While Len(Trim(Cells(y, "A"))) > 0 'A列のデータが存在する間、ループする
3.3 グループが変わった時の処理
A列の値が変化したら、グループが変わったら、
3.3.1 明細行をクリアします。といっても、不可視にしただけです。
'2からでもいいけど、一度全ての明細行を非表示にする For cnt明細行 = 1 To 5 '明細行を非表示にする ppSlide.Shapes("明細" & cnt明細行).Visible = False '不可視にする Next cnt明細行
枠外メモ:
明細行の枠が残っている方が好きな人もいれば、
今回のように枠が無い方がよいと依頼を受けたりもする。
>②テンプレートには、三流さまのサンプル資料は下線があると同じように
>図形（四角描画や線などをグループ化）を事前5行ほどにつくってあります。
>上記の図形描画の前面にテキストボックスを貼付けしているイメージになります。
>
>またExcelのレコード件数に応じて上記の不要画像は削除したいです。
明細行の図形も今回は消したかったので、
グループ化して、
まとめて、不可視と可視の切り替えで対応しました。
うまくアレンジして、使ってみてください。
3.3.2 右上グループ に 日付をセットする
'ページが変わったので、グループ化名を日付文字列でセット ※特殊処理？ものに合わせてアレンジ ppSlide.Shapes("右上グループ").TextFrame.TextRange.Text = Format(PageCODE, "mm/dd(aaa)") '↑ひな型・テンプレートに付けた名前 DoEvents
3.4 明細にExcelデータをセットする
3.4.1 まず、セットする明細を可視にする
ppSlide.Shapes("明細" & cnt明細行).Visible = True '明細行を表示する
単純に、処理したい行が、
cnt明細行 なので、
そのシェイプを可視にしただけ。
※明細1はグループ化されたシェイプなので、まとめで可視にする。
3.4.2 Excel1行をPowerPointテンプレ 明細XXのグループにセットする
Shapes("明細2").GroupItems("開始時刻")
など、
グループ化されたシェイプの項目にたどり着くには、
Shapes("グループ名").GroupItems("項目名・まぁメンバー名かな")
で、オブジェクトにたどり着ける。
これを利用して、Excelの見出し列が終わるまで、回しデータをセットしている。
'列のループですよ、y行内で横方向に進むぞ For x = 1 To 99 '99列までループにして途中でExitするループ str転記列名 = Trim("" & Cells(1, x)) '1行目の見出し x列で項目名を取得 If Len(str転記列名) = 0 Then Exit For '転記項目が無くなったら抜ける 'Excelから単純にItem(項目名)でデータセット、エラーを無視して項目名無しを回避 On Error Resume Next 'エラーが発生しても強引に次の命令に行け Set ppShape = Nothing 'これが無いと、前回オブジェクトが残る 'Shapes("明細XX").GroupItems("XXXXX")でアクセスする '詳細は単体テスト https://www.youtube.com/watch?v=XoNR5YrdtDQ を見てね Set ppShape = ppSlide.Shapes("明細" & cnt明細行).GroupItems(str転記列名) '↑セットするオブジェクトを 明細1行のグループ内の項目名で探す ppShape.TextFrame.TextRange.Text = Cells(y, x).Text 'Excelから文字列を代入 On Error GoTo 0 '忘れないで戻すぞ Next x
3.5 改ページのチェック
Excelの行を進ませる、次に行く。
と同時に、明細カウントも進む。
もし、グループが変化するなら、スライドを(ひながたを)jpgに保存する
cnt明細行 = cnt明細行 + 1 '明細のセット位置も次にするよ y = y + 1 '次の行へ※忘れて無限ループはシャレにならないよ・・・ '↑で、次の行に移動する。ここでグループが変わったら、 '3.5 いわゆる、改ページチェック If PageCODE <> Cells(y, "A") Then '保存されている値と比べ 変更されていたら '2023/06/25 現在のページをjpgに保存する Dim YYMM As String YYMM = Format(PageCODE, "mm/dd(aaa)") 'A列日付の分類をファイル名にする Dim strJPGFILENAME As String '保存ファイル名 '現在のExcelの場所\MM/DD(aaa)にしたいけど、半角/はダメですよ strJPGFILENAME = ActiveWorkbook.Path & "\" & StrConv(YYMM, vbWide) & ".jpg" '06/25(日)を↑StrConv(YYMM, vbWide)で０６/２５（日）と全角にする '↓で保存するときにファイル名に半角/スラッシュがNGなので ppSlide.Export strJPGFILENAME, "jpg" '↑単純に、.Exportで作成する End If
↑処理的には、Jpg保存のコードは変えてないので、
詳細は https://www.youtube.com/watch?v=xWqXdxGE8XU を見てください。
あれれ、今日7/17 6/25に作成コードを紹介・・・
時間の流れが速いですね。※読者の声:Ken3の対応が遅すぎです。 Ken3:すみません。。。
3.6 後始末
私の苦手な、後始末。
>完成と同じサイズでテンプレートは準備してあるので
>これをひな形にテキストボックスが展開がしたいです。
>最終的には、以前お願いしましたｊｐｇに保存するため
>PowerPointでの保存は不要です。
'ひな型は閉じる ppひな型.Close DoEvents Set ppひな型 = Nothing 'パワポも閉じる※ほかの編集中があったら、巻き込まれるから、どうしよう？ ppApp.Quit DoEvents Set ppApp = Nothing
4.終わりの挨拶
以上、
パワポで作成したテンプレートに
A列でグループ化した明細をセット
Jpgに保存して
サヨナラ
のサンプルコードでした。
アレンジして使ってみてください。
ソースコード全体
'パワポのテンプレートにデータをセット後 'A列の値が変化したら、 'A列日付をファイル名にして、jpgファイルとしてパワポのスライドを保存する Sub デバッグ20230717_データセット後JPG保存() 'PowerPointアプリの起動 Dim ppApp As Object 'PowerPoint.Application Set ppApp = CreateObject("PowerPoint.Application") ppApp.Visible = True '可視にする DoEvents 'ひな型ファイルを開く Dim strPPFName As String strPPFName = ActiveWorkbook.Path & "\ひな型0717.pptx" '※Excelと同じ場所を開く '開く、コピー元を変数に入れる Dim ppひな型 As Object 'PowerPoint.Presentation 'pp:プレゼンテーション Set ppひな型 = Nothing '初期化、エラーチェックもかねて On Error Resume Next '↓でSet 取得エラー時に次へ ファイルが開けなかった時 Set ppひな型 = ppApp.Presentations.Open(strPPFName, msoTrue) 'リードオンリーで開く DoEvents On Error GoTo 0 'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意 '↑単純に、.Open "ファイル名" で開いただけです If ppひな型 Is Nothing Then '↑上で開けたか？ 'openエラーの時、開けなかったことを知らせる MsgBox strPPFName & "が開けません確認してください", vbExclamation Exit Sub 'んっ？空のppAppが残るか、これだと・・・ End If Dim ppSlide As Object 'As PowerPoint.Slide Set ppSlide = ppひな型.Slides(1) 'ひな型の1ページ目を使用したいので Dim y As Long '行カウンタ Dim PageCODE As Variant 'この値がキーが変更されたら改ページする Dim x As Long '列のカウンター Dim cnt明細行 As Long '明細行1～5をカウントする Dim str転記列名 As String 'Excelの見出し などppの転記先テキストボックス名 Dim ppShape As Object 'As PowerPoint.Shape ↑の名前のシェイプを代入 'A列が存在する間ループする y = 2 'A2から始めたいので 2 PageCODE = "初回に改ページしてねの意味を込めて長文" '本当はPageCODE ="" などで初期化 While Len(Trim(Cells(y, "A"))) > 0 'A列のデータが存在する間、ループする '改ページチェック CODEが変わったか？チェックする If PageCODE <> Cells(y, "A") Then '保存されている値と比べ 変更されていたら PageCODE = Cells(y, "A") '値を保存する※このキー値の間処理をするため保存 'キー、基準が変わったので、ひな型の明細行を非表示にする '2からでもいいけど、一度全ての明細行を非表示にする For cnt明細行 = 1 To 5 '明細行を非表示にする ppSlide.Shapes("明細" & cnt明細行).Visible = False '不可視にする Next cnt明細行 'ページが変わったので、グループ化名を日付文字列でセット ※特殊処理？ものに合わせてアレンジ ppSlide.Shapes("右上グループ").TextFrame.TextRange.Text = Format(PageCODE, "mm/dd(aaa)") '↑ひな型・テンプレートに付けた名前 DoEvents 'ページが変わったら、明細行も1からなので cnt明細行 = 1 'ppセットへ名前1にリセット ホント、ここ、忘れないでね・・・ End If '明細のセット ↑で、作られた枠、ページにセットする '3.4.1 まず、セットする明細を可視にする ppSlide.Shapes("明細" & cnt明細行).Visible = True '明細行を表示する '3.4.2 Excel1行をPowerPointテンプレ 明細XXのグループにセットする '列のループですよ、y行内で横方向に進むぞ For x = 1 To 99 '99列までループにして途中でExitするループ str転記列名 = Trim("" & Cells(1, x)) '1行目の見出し x列で項目名を取得 If Len(str転記列名) = 0 Then Exit For '転記項目が無くなったら抜ける 'Excelから単純にItem(項目名)でデータセット、エラーを無視して項目名無しを回避 On Error Resume Next 'エラーが発生しても強引に次の命令に行け Set ppShape = Nothing 'これが無いと、前回オブジェクトが残る 'Shapes("明細XX").GroupItems("XXXXX")でアクセスする '詳細は単体テスト https://www.youtube.com/watch?v=XoNR5YrdtDQ を見てね Set ppShape = ppSlide.Shapes("明細" & cnt明細行).GroupItems(str転記列名) '↑セットするオブジェクトを 明細1行のグループ内の項目名で探す ppShape.TextFrame.TextRange.Text = Cells(y, x).Text 'Excelから文字列を代入 DoEvents On Error GoTo 0 '忘れないで戻すぞ Next x cnt明細行 = cnt明細行 + 1 '明細のセット位置も次にするよ y = y + 1 '次の行へ※忘れて無限ループはシャレにならないよ・・・ '↑で、次の行に移動する。ここでグループが変わったら、 '3.5 いわゆる、改ページチェック If PageCODE <> Cells(y, "A") Then '保存されている値と比べ 変更されていたら '2023/06/25 現在のページをjpgに保存する '詳細は https://www.youtube.com/watch?v=xWqXdxGE8XU を見てください。 Dim YYMM As String YYMM = Format(PageCODE, "mm/dd(aaa)") 'A列日付の分類をファイル名にする Dim strJPGFILENAME As String '保存ファイル名 '現在のExcelの場所\MM/DD(aaa)にしたいけど、半角/はダメですよ strJPGFILENAME = ActiveWorkbook.Path & "\" & StrConv(YYMM, vbWide) & ".jpg" '06/25(日)を↑StrConv(YYMM, vbWide)で０６/２５（日）と全角にする '↓で保存するときにファイル名に半角/スラッシュがNGなので ppSlide.Export strJPGFILENAME, "jpg" '↑単純に、.Exportで作成する End If Wend '3.6 後始末 'ひな型は閉じる ppひな型.Close DoEvents Set ppひな型 = Nothing 'パワポも閉じる※ほかの編集中があったら、巻き込まれるから、どうしよう？ ppApp.Quit DoEvents Set ppApp = Nothing MsgBox "処理終了、jpgファイルを確認してね" End Sub
過去記事:
ken3memo.hatenablog.com
ken3memo.hatenablog.com
ken3memo.hatenablog.com
