As ListObject テーブルはリストオブジェクトで、
Set objTB = shNEW.ListObjects.Add(xlSrcRange, rBASE.CurrentRegion, , xlYes)
でテーブル・表を作成してからソート項目をセットして実行しただけです。
1.実行結果の違いを見せる
1.1 まず、前回まで作成した順番を変更しない垂れ流し出力
前回の記事
動画:矢印を引くコードはこっちをみてください。
https://www.youtube.com/watch?v=Rnji4U4BI7k
前回の動画解説↑でパワポのスクショもどきに矢印・線を引きました。
これが、未ソートのやりっぱなしで、
ア.視聴者からZの法則ってしってますか？
イ.手を抜かないで作成してください
とコメントをいただきました。コメントありがとう。
1.2 今回の完成系 テーブル化とTop,Leftでソートした出力
今回の完成品:
https://youtu.be/b0K6muJYdOI?si=wooDdPCciCMoXgyu&t=140
2.キッカケの厳しい意見を紹介する
今日も厳しいご意見をいただく
Kさんへ
プログラミングとは、単にコードを書くこと以上の技術です、プログラミングなめるな
プログラミングの世界では、データ出力は単なる情報の提示以上のものです。
まさかZの法則を知らない？僕よりも10以上年上なのに？Zの法則については、一度インターネットで検索し、その重要性を理解してください。
データを出力する際には、左上から右下へと情報が流れるように配置し、表形式での出力ではTOP, LEFTでソートすることがエチケット手を抜くなテストデータであっても、手を抜くことなく、正確なプログラミングを行うこと。
Zの法則を再度確認し、その理解を深めてください。言葉が厳しくなってしまいましたが、Webにアップロードされるコードやデータは多くの人に見られます。
そのため、丁寧なデータ作成とプログラム作成を心がけろ
2.1 Ken3:「レイアウトで使う "Zの法則" について箇条書きでポイントを教えてください」
AI回答:
もちろんです！「Zの法則」は、
ビジュアルデザインやプレゼンテーションのレイアウトにおいて、
読み手の視線を効果的に誘導するための法則です。以下にポイントを箇条書きで示します：
1. 目線の流れを意識する：
- 資料を読む人の目線は、一般的に「Z」字に動くことが多いです。
- 左上から始まり、右上、左下、右下の順番で目線が動くことを考慮しましょう。2. Z字の動線上にコンテンツを配置する：
- 最初に目線がいく左上にアピールポイントや伝えたいことを置きます。
- 次に左から右に向けてコンテンツを並べていきます。
- その後、左下→右下にコンテンツを配置します。3. 効果は紙の資料だけにとどまらない：
- 「Zの法則」は紙媒体だけでなく、店内の陳列棚の商品レイアウトなどでも有効です。
- 実店舗のレイアウトを担当している方も、ぜひこの法則を意識して商品の配置を考えてみてください。この法則を活用することで、
資料やプレゼンテーションの理解力が向上し、
読み手にわかりやすいレイアウトを作成できます。ぜひ参考にしてみてくださいね！ソース: Bing との会話 2024年3月19日
3.ソースの修正
ソート処理を行いたいので、いつものようにマクロ記録で
①テーブル(Ctrl+T)にして、②Top,Leftでソート(データ--並べ替え)
を記録してみた
https://youtu.be/b0K6muJYdOI?si=nm1Tff4aBLGJY1-X&t=601
下記、記録されたコード
Sub Macro3() Range("B1").Select Application.CutCopyMode = False ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$1:$J$33"), , xlYes).Name = _ "テーブル1" Range("テーブル1[#All]").Select ActiveWorkbook.Worksheets("スライド7").ListObjects("テーブル1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("スライド7").ListObjects("テーブル1").Sort.SortFields.Add2 _ Key:=Range("テーブル1[上位置.Top]"), SortOn:=xlSortOnValues, Order:=xlAscending _ , DataOption:=xlSortNormal ActiveWorkbook.Worksheets("スライド7").ListObjects("テーブル1").Sort.SortFields.Add2 _ Key:=Range("テーブル1[左位置.Left]"), SortOn:=xlSortOnValues, Order:=xlAscending _ , DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("スライド7").ListObjects("テーブル1").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("K3").Select End Sub
3.1 テーブル範囲をどうしよう？
Ctrl+Tのテーブル作成
Range("B1").Select Application.CutCopyMode = False ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$1:$J$33"), , xlYes).Name = _ "テーブル1" Range("テーブル1[#All]").Select
範囲をどうしよう・・・
https://youtu.be/b0K6muJYdOI?si=CIGn8SR1s3KRMueJ&t=829
そうだ、カレント レギオンがあるじゃん。
'↑で出力したデータをテーブル化 CurrentRegionで範囲指定してテーブル作成 Dim objTB As ListObject 'テーブルはリストオブジェクト Set objTB = shNEW.ListObjects.Add(xlSrcRange, rBASE.CurrentRegion, , xlYes) Dim strTBName As String strTBName = "TB" & shNEW.Name 'TB+シート名をテーブル名する objTB.Name = strTBName DoEvents
3.1.1 細かい変更点
やっと、基準の出力先を頭に
Const str基準セル = "C2" 'データの出力先、表の起点
と記載して、
共通で使用するように変更した。※過去のコードはそのままですが、今後・・・
3.2 ソートのキーを指定する
何も考えないで、作成してたから、
上位置.Top,左位置.Left
なんて、列名にしていたから、
ActiveWorkbook.Worksheets("スライド7").ListObjects("テーブル1").Sort.SortFields.Add2 _ Key:=Range("テーブル1[上位置.Top]"), SortOn:=xlSortOnValues, Order:=xlAscending _ , DataOption:=xlSortNormal ActiveWorkbook.Worksheets("スライド7").ListObjects("テーブル1").Sort.SortFields.Add2 _ Key:=Range("テーブル1[左位置.Left]"), SortOn:=xlSortOnValues, Order:=xlAscending _ , DataOption:=xlSortNormal
ピリオドこれは、誤解しそうなので、
列名をシンプルにTop,Leftに変更して、設定してみた。
https://youtu.be/b0K6muJYdOI?si=fLv-vFgCc3uTb72p&t=1344
↑こんな感じで、コードを書いてみました。
3.3 完成したソースコードを使い再度実行・説明する
https://youtu.be/b0K6muJYdOI?si=LBV9CKid9RHiM74y&t=1761
↑実行結果と下記↓のソースをみながら、試して、アレンジしてください。
Option Explicit Const str基準セル = "C2" 'データの出力先、表の起点 '起動済みの既存 パワーポイントのスライドから 'パワポのシェイプ情報とイメージjpgをexcelシートへ書き出す 'ex:新規ブックを追加して、pp:スライドの情報をex:シート単位で貼り付ける '24/03/19:テーブル化とTop,Leftの2項目でソート Sub test240319_01ppスライドのシェイプ情報をexシートへ() 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 '新規に貼り付け先のExcelブックを作成したいので Dim wbNEW As Workbook Set wbNEW = Workbooks.Add '新規ブックの追加 Dim shNEW As Worksheet '新規のシート用に変数を作成する Dim strJPGNAME As String '一時保存する名前 strJPGNAME = ThisWorkbook.Path & "\ppスライドtemp.jpg" Application.Top = 200 '動画作成用、新規のブック位置,本番では消す Application.Left = 200 '動画作成用、新規のブック位置,本番では消す Dim picShape As Shape '挿入画像はShapeなので Dim p As Integer, y As Integer 'pページ、y行 Dim objShape As Object 'As PowerPoint.Shape 'パワポのシェイプ、テキスト、図形ほか 'パワポのスライドをExcelシートに For p = 1 To ppApp.ActivePresentation.Slides.Count 'スライド数ループ pページ 'pp画像を用意する 単純に.Exportでテンポラリ画像を作成 ppApp.ActivePresentation.Slides(p).Export strJPGNAME, "JPG" DoEvents '↑jpgファイルを作成しているので、念のため '画像をシートへ貼る Pictures.InsertがActiveSheetだったので※後で調べる・・・ Set shNEW = wbNEW.Sheets.Add(Before:=wbNEW.Worksheets(wbNEW.Worksheets.Count)) '新規シートを一番後ろに追加するために↑細工してみた shNEW.Name = "スライド" & p 'シート名をスライド1,2,3..にする shNEW.Columns("A:A").ColumnWidth = 79.5 '列幅を変更する ' 画像を0,0へ 埋め込み形式で挿入 ファイル名,リンク,保存保持,left,top,Width,Height Set picShape = shNEW.Shapes.AddPicture(strJPGNAME, False, True, 0, 0, -1, -1) picShape.Name = "ppスライド" & p picShape.Width = 480 '挿入後幅を調整する 'ここから、シェイプの情報を書きこむ '書き込み開始位置の左上のセルを指定して、offictで対応する Dim rBASE As Range '拠点、書き込みの左上を代入する Set rBASE = shNEW.Range(str基準セル) rBASE.Select '0行目に見出しを書き込む rBASE.Offset(0, 0) = "Page番号" rBASE.Offset(0, 1) = "ID" rBASE.Offset(0, 2) = "Name" rBASE.Offset(0, 3) = "Type" '種類※あると便利 rBASE.Offset(0, 4) = "Left" 'ソートで仕様 rBASE.Offset(0, 5) = "Top" rBASE.Offset(0, 6) = "Width" '幅と高さ 24/03/02 rBASE.Offset(0, 7) = "Height" rBASE.Offset(0, 8) = "テキスト10文字" 'テキストがあれば判断時便利かな？ 'pページのスライド内のシェイプを探る y = 1 '基準の一つ下からセットする For Each objShape In ppApp.ActivePresentation.Slides(p).Shapes rBASE.Offset(y, 0) = p 'スライド番号(ページ番号) rBASE.Offset(y, 1) = objShape.ID 'IDで今回、区別したいので※24/03/02追加 rBASE.Offset(y, 2) = objShape.Name 'オブジェクトの名前 rBASE.Offset(y, 3) = objShape.Type '※種類 rBASE.Offset(y, 4) = objShape.Left '位置 左上の左 判断材料 rBASE.Offset(y, 5) = objShape.Top '位置 左上の縦 rBASE.Offset(y, 6) = objShape.Width ' rBASE.Offset(y, 7) = objShape.Height 'オブジェクトがテキストを持っているか？チェックしてからセット If objShape.HasTextFrame = msoTrue Then 'テキストフレームあり If objShape.TextFrame.HasText = msoTrue Then 'テキスト範囲あり rBASE.Offset(y, 8) = Left(objShape.TextFrame.TextRange.Text, 10) 'テキストを10文字だけ書き込む↑,99文字など好みの文字で End If End If y = y + 1 'セットする行を次へ Next '↑で出力したデータをテーブル化 CurrentRegionで範囲指定してテーブル作成 Dim objTB As ListObject 'テーブルはリストオブジェクト Set objTB = shNEW.ListObjects.Add(xlSrcRange, rBASE.CurrentRegion, , xlYes) Dim strTBName As String strTBName = "TB" & shNEW.Name 'TB+シート名をテーブル名する objTB.Name = strTBName DoEvents 'Top,Leftでソートする objTB.Sort.SortFields.Clear 'ソートの項目をクリアしてから追加する objTB.Sort.SortFields.Add2 _ Key:=Range(strTBName & "[Top]"), SortOn:=xlSortOnValues, Order:=xlAscending _ , DataOption:=xlSortNormal objTB.Sort.SortFields.Add2 _ Key:=Range(strTBName & "[Left]"), SortOn:=xlSortOnValues, Order:=xlAscending _ , DataOption:=xlSortNormal With objTB.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Next MsgBox "処理終了、画像を確認してください" End Sub 'Excel矢印を作成して、場所を指す 'セルの位置から矢印を画像に引く '24/03/19:Set rBASE = Range("B1")をSet rBASE = Range(str基準セル)にしただけ Sub test240319_02スクショもどきに矢印を引く() Const スケール調整 = (480 / 960) 'スクショもどきと現物を調整する Dim shpArrow As Shape '矢印にする Dim rBASE As Range Set rBASE = Range(str基準セル) '一番上でConst定義した出力先を使う Dim y As Integer Dim Start_X As Double, Start_Y As Double Dim End_X As Double, End_Y As Double For y = 1 To 999 'いつものとりあえず999まで回す If Trim("" & rBASE.Offset(y, 0)) = "" Then Exit For 'データ無しなら抜ける Start_X = rBASE.Offset(y, 4) * スケール調整 'ppのLeft Start_Y = rBASE.Offset(y, 5) * スケール調整 'ppのTop End_X = rBASE.Offset(y, 2).Left '3列目セルのLeft 0から始まるので2を指定 End_Y = rBASE.Offset(y, 2).Top + (rBASE.Offset(y, 2).Height / 2) 'セルのTop + Height÷2 '矢印の作成 Set shpArrow = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, Start_X, Start_Y, End_X, End_Y) shpArrow.Name = "矢印" & y '名前を変更、後で消しやすいように With shpArrow.Line '線のパラメーターをセットする、形を変える .BeginArrowheadStyle = msoArrowheadTriangle '開始の形 .EndArrowheadStyle = msoArrowheadTriangle '終了の形 .Visible = msoTrue .Weight = 4.5 '幅 End With Next End Sub 'シェイプの削除 Sub test240319_03shp_Delete() '削除 矢印XXX のシェイプを削除する Dim Shp As Shape Dim n As Integer 'ループで後ろから"矢印"の名前が付くシェイプを消す For n = ActiveSheet.Shapes.Count To 1 Step -1 Set Shp = ActiveSheet.Shapes(n) If Left(Shp.Name, 2) = "矢印" Then '頭2文字が"矢印"なら削除する Shp.Delete End If Next End Sub
4.おわりの挨拶
Zの法則、いまさらだけど、勉強になりました。
確かに、出力が整理されて見やすくなりましたね。
※必要以上に(変に)矢印がクロスしないで引かれるのかなぁ。
＞テストデータであっても、手を抜くことなく、正確なプログラミングを行うこと。
＞Zの法則を再度確認し、その理解を深めてください。
＞
＞言葉が厳しくなってしまいましたが、Webにアップロードされるコードやデータは多くの人に見られます。
＞そのため、丁寧なデータ作成とプログラム作成を心がけろ
ドキっとするコメントでした。
解説中に緊張で笑うのは置いといて、結果が手抜きとみられているのは、
コメントが無いと指摘されないと、なかなか、気が付かなかったり。
これからも、厳しい指摘・コメント待ってます。
(※もちろん、温かいコメントも待ってますオイオイ・・・)
イラスト PCを操作する太った作業員 作業員へ少し怒って指示を出す男性
