三流君 ken3のmemo置き場

三流プログラマーのメモ書きです。主にVBAやWindowsの話題が多いです

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。

よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]

ExcelからPowerPoint表の列幅を取得する 値を変更する Excelから更新する方法

4.ExcelからPowerPoint表の列幅を取得する
https://www.youtube.com/watch?v=GzRznqxvKoA&t=2335s
38:55 ~ ↑4.ExcelからPowerPoint表の列幅を取得する
45:35 ~ 実行結果 パワポ表の列幅をExcelシートへ書き込む

デバッグが終了したので、
次は、Excelからアクティブなパワポ表の列幅を取得してみます

Excel
A列,B列,C列,,,
Page,シェイプ名,列数,列幅,,,
に書き込みます。

'起動済みの既存 パワーポイント
'スライド .Shapes から HasTableでテーブルを判断して
'アクティブシートに列幅をセット ※勝手に全クリアして書き込むので※※注意
Sub test20240123_01パワポのTable列幅を取得()

    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") = "Shape.Name"
    Range("C1") = "列数"
    Dim n As Integer
    For n = 1 To 9  '手抜きで見出しは9まで、おいおい
        Cells(1, n + 3) = "列幅" & n    'n+3でD1から書き込む
    Next n

    Dim p As Integer, y As Integer   'pページ、y行
    Dim objShape As Object  'As PowerPoint.Shape 'パワポのシェイプ、テキスト、図形ほか
    Dim objTABLE As Object  'As PowerPoint.Table 'シェイプの下Tableオブジェクト
    Dim objCOL As Object    'As PowerPoint.Column  'テーブルの列

    y = 2  '取得したテキストデータを二行目から書きたいので
    For p = 1 To ppApp.ActivePresentation.Slides.Count  'スライド数ループ pページ
        'pページのスライド内のシェイプを探る
        For Each objShape In ppApp.ActivePresentation.Slides(p).Shapes
        
            'オブジェクトがテーブル・表を持っているか?チェック
            If objShape.HasTable = msoTrue Then 'Tableを持っているなら
                Set objTABLE = objShape.Table   'シェイプのテーブルを代入
                
                Cells(y, "A") = p             'スライドページ
                Cells(y, "B") = objShape.Name 'シェイプの名前
                Cells(y, "C") = objTABLE.Columns.Count '列数

                For n = 1 To objTABLE.Columns.Count
                    Set objCOL = objTABLE.Columns(n) 'n番目の列を代入
                    '列幅を書き出す n+3でD列から書き込むように細工した
                    Cells(y, n + 3) = objCOL.Width '列幅
                Next
                
                y = y + 1   'セットする行を次へ
            
            End If  'HasTable = True↑表の時のみ、処理する

        Next
    Next
    
    MsgBox "処理終了、確認してください"
    
End Sub

5.次は、逆パターン Excelの列幅をPowerPointにセットして表の列幅を変更する
https://www.youtube.com/watch?v=GzRznqxvKoA&t=2861s
47:41 ~ ↑5.次は、逆パターン Excelシートの列幅をPowerPointにセットして表の列幅を変更する
49:04 実行結果を先に見せる

Excel側で値を修正したら、
その値を使用して、パワポの表で列幅を変更する、
そんな処理です。

あっ、ExcelからPowerPoint表の列幅変更でいいのか

'起動済みの既存 パワーポイント
'アクティブシートの列幅をパワポの表にセット
'ページとシェイプで表を指定して表の列幅をセットする
Sub test20240123_02パワポのTableへ列幅をセット()

    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 objShape As Object  'As PowerPoint.Shape 'パワポのシェイプ、テキスト、図形ほか
    Dim objTABLE As Object  'As PowerPoint.Table 'シェイプの下Tableオブジェクト
    Dim objCOL As Object    'As PowerPoint.Column  'テーブルの列
    
    Dim strShpName As String  'B列の名前
    Dim n As Integer  '列のカウンタ、+3してD列~使う予定

    y = 2  '1行目が見出しなので、二行目からデータをセットする
    While Len(Cells(y, "A")) <> 0 'A列の文字数が0以外の間ループ、A列がなくなるまで
        p = Cells(y, "A")          'A列からスライド番号(ページ番号)
        strShpName = Cells(y, "B") 'B列から名前
        Set objShape = Nothing  '初期化
        On Error Resume Next  '取得エラー時に次へ行く
        'pページのスライド内のシェイプを取得 A列のページ と B列の名前を使う
        Set objShape = ppApp.ActivePresentation.Slides(p).Shapes(strShpName)
        On Error GoTo 0  'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意
        
        If objShape Is Nothing Then  '名前のエラーチェック
            MsgBox p & "ページの名称" & strShpName & "が見つかりません、確認してください"
            Exit Sub
        End If
        
        '表の列幅をセットする 列幅を変更する
        'シェイプがテーブル・表を持っているか?チェック
        If objShape.HasTable = msoTrue Then 'Tableを持っているなら
            Set objTABLE = objShape.Table   'シェイプのテーブルを代入
            For n = 1 To Cells(y, "C")  'C列の列数を信じてループする
                Set objCOL = objTABLE.Columns(n) 'n番目の列を代入
                '列幅をセットする n+3でD列から値を取り出しセットに細工
                objCOL.Width = Cells(y, n + 3).Value  '列幅のセット
            Next
        End If  'HasTable = True↑表の時のみ、処理する

        y = y + 1   '次のデータへ
            
    Wend
    
    MsgBox "処理終了、パワポの列幅を確認してください"
    
End Sub

6.おわりの挨拶

伝えたかった事、
1.ウォッチ式でプロパティを探る方法
2.蛇足:Excelに取り出して、編集、戻すと便利かも?
でした。

処理のヒント・参考となれば幸いです。



前半のウォッチ式で表の列幅を探る方法も
https://youtube.com/live/GzRznqxvKoA
↑お時間のある時に、二倍速で見てください。
目次
00:00 ライブ開始の挨拶
00:33 1.いつもの手ウォッチで探る
05:38 変数選択後、右クリック後、ウォッチ式の追加 操作方法
08:08 1.1 表の判断は HasTable
11:29 1.2 列幅は Width
15:14 Item1など、中身を探る
16:16 2.列幅の値を代入するには?変更するには
18:09 2.1 Columns.Item(n)
20:19 2.2 Table.Columns(n)
28:05 2.3 頭ActivePresentationからいくと
31:38 3.全ての表を探し、列幅を取得する
38:55 4.ExcelからPowerPoint表の列幅を取得する
45:35 実行結果 パワポ表の列幅をExcelシートへ書き込む
47:41 5.次は、逆パターン Excelシートの列幅をPowerPointにセットして表の列幅を変更する
49:04 実行結果を先に見せる
51:06 コードを説明する
55:23 6.おわりの挨拶 伝えたかった事を再度伝える
59:35 再度伝えたいことを説明する

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。

  1. [VBA・マクロ プログラミング]の解説
    当店の人気はVBA系のCreateObject("XXXXXX.application")で他のアプリケーションを操作するサンプルが人気です
  2. [プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
    三流君を踏み台にする
  3. [古いクラシック ASP(Active Server Pages)]の解説。
  4. [元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)