まず手動でスライド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で可能みたいです。
元動画の区切りやトリミングで
※トリミング、現在の問題点、スライド切り替え時に動画が崩れる・・を確認して下さい。。。
時間のある時に動画を流し見してもらえるとうれしいです。
解決のヒントとなれば、幸いです。
崖を登りきらないと(プログラムを最後まで完成させないとダメなのに)

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

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

 
