三流君 ken3のmemo置き場

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

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。
Ken3三流君の連絡先:
[google formsで連絡する]
上記の問い合わせフォームに質問・感想など気軽に書き込んでください

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

PowerPoint VBA 動画ShapeのプロパティMediaFormatを使う ブックマーク位置はMediaBookmarksでトリミングを行うには.StartPointと.EndPointに値をセットする

まず手動でスライド1に挿入した動画Shapeに手動でブックマークをセットして区切る
その後、マクロで↑スライド1の動画シェイプを各スライドへコピーして、
動画のプロパティMediaFormatから
ブックマーク位置は.MediaBookmarksで区切り位置を取得し、
トリミング位置の.StartPoint.EndPointに値(トリミングの範囲)をセットして、
各スライドにコピーした動画を分割(トリミングする)

説明、長いよ・・・
作成したソースコードを紹介します。
※メモでとりあえず、ブログに書き込みます
※※ここから、ソースをコピーして、使ってもらう

Option Explicit

'スライド1の動画をブックマーク分スライド2以降にコピーして、
'ブックマークの位置でトリミングを行う
'※動画をコピーするので、重くなるので注意
'ここから
Sub 動画トリミング設定を行う240822()
    Dim sld As slide
    Dim shp As shape
    Dim myMediaFormat As MediaFormat  'トリミング等で使う動画のフォーマット

    Dim str動画シェイプ名 As String
    str動画シェイプ名 = "トリミングMP4"
    '↑※配置--オブジェクトの選択と表示で↑識別する名前を自分で付けてね

    ' アクティブな1枚目のスライドを取得
    Set sld = ActivePresentation.Slides(1)
    
    '指定された動画のシェイプを代入する
    Dim shpMP4動画 As shape
    Set shpMP4動画 = Nothing
    On Error Resume Next  '取得エラー時に次へ
    Set shpMP4動画 = sld.Shapes(str動画シェイプ名)
    On Error GoTo 0  'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意

    If shpMP4動画 Is Nothing Then  '動画のシェイプが見つからなかったら
        MsgBox str動画シェイプ名 & "設定後に、再テストしてね", vbExclamation
        Exit Sub
    End If

    '動画のシェイプ設定,ブックマーク確認とトリミングをコピー前に元に戻す
    With shpMP4動画.MediaFormat  '操作するシェイプ
        Dim BK_MAXCount As Integer  'ブックマークの数
        BK_MAXCount = .MediaBookmarks.Count
        If BK_MAXCount = 0 Then  'ブックマーク未設定なら
            MsgBox "ブックマークが0件です、確認して", vbExclamation
            Exit Sub
        End If
        'トリミング位置を初期化する 先頭を0と最後=動画の長さLengthにする
        .StartPoint = 0  'スタートを0先頭に戻す
        .EndPoint = .Length '終了位置=長さにする
    End With

    '2ページ目から ブックマークの数+1ページまで貼り付ける
    '(ブックマークが2個なら、左,中,右の3分割なので、ブックマーク+1個分割される)
    Dim p As Integer
    Dim sldコピー先 As slide  'コピー先のスライド
    
    For p = 2 To BK_MAXCount + 1  'ブックマーク+1ページまでコピーする
        Set sldコピー先 = ActivePresentation.Slides(p) 'pページに貼り付けたい
        'コピー前に同じ名前があったら削除する
        On Error Resume Next  '取得エラー時に次へ 存在チェックを手抜く
        sldコピー先.Shapes(str動画シェイプ名).Delete
        On Error GoTo 0  'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意
        
        shpMP4動画.Copy  '元動画シェイプをコピーする
        sldコピー先.Shapes.Paste  '位置も貼付コピーされるのでこれが便利
    Next
    
    'ブックマークを処理する
    Dim sld処理 As slide  '処理中のスライド
    Dim shp処理 As shape  'トリミング処理を行う動画シェイプ

    '初め 1スライド目 は、0~ブックマーク1でトリミング
    Set sld処理 = ActivePresentation.Slides(1) 'pページに貼り付けたい
    Set shp処理 = sld処理.Shapes(str動画シェイプ名)
    With shp処理.MediaFormat  '操作するシェイプ
        .StartPoint = 0  'スタートを0 上でやっているから、再セットしなくても?
        .EndPoint = .MediaBookmarks(1).Position '1つ目のBKで終了 トリミング
    End With
    
    For p = 2 To BK_MAXCount  'ブックマークまで処理する、最後は後で処理
        Set sld処理 = ActivePresentation.Slides(p) 'pページを処理
        Set shp処理 = sld処理.Shapes(str動画シェイプ名)  '動画のシェイプ
        With shp処理.MediaFormat  '操作するシェイプ
            .StartPoint = .MediaBookmarks(p - 1).Position '2ページ目のスタートはBK1
            .EndPoint = .MediaBookmarks(p).Position '2ページ目のエンドはBK2なのでp
        End With
    Next
    
    '終わりは、またまた、特殊処理
    Set sld処理 = ActivePresentation.Slides(BK_MAXCount + 1) 'BK+1が分割最後
    Set shp処理 = sld処理.Shapes(str動画シェイプ名)  '動画のシェイプ
    With shp処理.MediaFormat  '操作するシェイプ
        .StartPoint = .MediaBookmarks(BK_MAXCount).Position '最後のBKがスタートは位置
        .EndPoint = .Length '終了位置=長さになる、上でセットているからやらなくても・・
    End With
    
    MsgBox "動画トリミング処理終了、各スライドページを確認してね", vbInformation

End Sub

'ここまで
'をコピペする

まず、
マクロ実行結果:
https://youtu.be/WStfSF4UgM0?si=4nGKdEYbCt8_sSXM&t=1038
↑から、見てもらえるといいかも。


手動の事前準備;(※動画が前後してしまいますが)
私の作成した、
・山登りとプログラムのMP4
・10枚のスライド
で、実験してみます。

今回の処理手順:
1.スライド1枚目にすでに録画済みのmp4動画ファイルを挿入する

1.1 表示場所、サイズを調整する

1.2 名前を付ける
配置--オブジェクトの選択と表示で識別する名前を自分で付ける
str動画シェイプ名 = "トリミングMP4"
ここでは、動画を選択して、"トリミングMP4"と名前を付けた。

1.3 ブックマークを付ける
動画をダブルクリックして、再生タブのメニューから、
ブックマークの追加を使用して、
スライド単位で使いたい範囲をブックマークで区切る

手動で挿入した動画にブックマークを設置します
https://youtu.be/WStfSF4UgM0?si=4eAz0nEZx_LiFPJV&t=593
↑ここから、ブックマークを使用して、マクロを使用して動画を分割する前の手動操作です


結果を見せる:
結果、トリミングは出来たけど、最終結果でトリミング境界線で不具合が発生?

終結果のビデオのエクスポート結果
https://youtu.be/WStfSF4UgM0?si=mRsayHBaJB9iuaJ-&t=1495

ここまでは、PowerPointで可能みたいです。
元動画の区切りやトリミングで
※トリミング、現在の問題点、スライド切り替え時に動画が崩れる・・を確認して下さい。。。

時間のある時に動画を流し見してもらえるとうれしいです。
解決のヒントとなれば、幸いです。



崖を登りきらないと(プログラムを最後まで完成させないとダメなのに)

途中で止まってしまう、がんばって

この壁、プログラムの問題点、乗り切れるのか?

目の前の問題、この壁を乗り越えられるのかなぁ?

ロープにしがみついて、動けなくなった、太ったおじさん・・・

途中ロープにしがみつき、動けなくなったオジサンの姿 最悪です
体重重くても、笑顔で楽しく登りたいよね

ランダムな占い

再生リスト:[占い 今日のラッキーカラー]をショート動画

Ken3 ホームページ 目次

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

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



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