Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Pro : Microsoft 365)
パラパラ漫画
投稿日時: 22/05/09 12:57:33
投稿者: ip8bk

質問失礼します。
 
vbaで2枚以上の画像を使ってパラパラ漫画を作成することは可能でしょうか?
 
下記の形式で作成を検討しております。
 
ご存知の方、どうぞよろしくお願い致します。
 
画像:JPG、PNG、GIF、SVG
動画:MP4、WEBM、
3Dモデル:GLB、GLTF

投稿日時: 22/05/09 13:05:05
投稿者: ip8bk

追記です。
 
エクセル上で再生させるのではなく、特定の形式に保存してから動かす必要があります。

回答
投稿日時: 22/05/09 14:46:05
投稿者: taitani

引用:
可能でしょうか?

という問いであれば、可能です。
 
元の素材は?
->Excel上のオートシェイプ?画像?
->外部の画像?
 
パラパラ漫画は、Excel上?
 
どこまで作成したのでしょうか。
作成を行った、VBA をこちらに記載をお願いします。
 
ここは、あなたのアイデアを具現化する場所ではないことが前提です。

投稿日時: 22/05/09 15:18:34
投稿者: ip8bk

ご返信ありがとうございます。
 
画像は私が作成しました。形式はpngです。
 
調べても解決できなかったので、ぱらぱら漫画はできないのかとあきらめていました。
 
ご存知とのことですので、作成手順の概要を教えてもらえませんでしょうか?
 

引用:
パラパラ漫画は、Excel上?

windows上で動かしたいです。

回答
投稿日時: 22/05/09 15:35:49
投稿者: taitani

うーん、VBA を利用するメリットが無いような気がします。
単純に、画像が複数あり、それを GIF や 動画として保存を行えるアプリを利用する。
出力されたものを Windows のアプリを利用して、表示するほうがいいと思います。
 
Excel の VBA を経由する意図が気になります^^;

投稿日時: 22/05/09 15:55:50
投稿者: ip8bk

vbaで画像を作成した後にパラパラ漫画が作成できると、とても効率的なので、vbaで検討しています。
画像の枚数が多いので、専用アプリは使わない方向で考えています。

回答
投稿日時: 22/05/09 15:57:31
投稿者: WinArrow
投稿者のウェブサイトに移動

パラパラ漫画は、通常、1秒間に、複数枚の画像を表示・・・・30フレームのような表現
しかし、VBAで、1つの画像を読み込むのみ、どのくらいの時間が掛かると思いまうか?
試してみるとよいでしょう。

回答
投稿日時: 22/05/09 16:01:22
投稿者: taitani

VBA で画像を作成・・・どのように作成を行っているか教えてほしいです。
 
そうですね、以下のサイトが参考になると思います。
http://www.ken3.org/vba/backno/vba028.html

回答
投稿日時: 22/05/09 16:06:28
投稿者: Suzu

したい事が良くわかりません。
 
同じ位置(セル)に 、次々と画像を表示し、動画の様に見せる事
 PowerPoint のスライド 画面切り替え の タイミング を 極端に短くし 動画の様に見せる
と思います。
 
それなのに、動画をソースとして入れるのですか?
 
 
とりあえず。。。
 
1. シート「Sheet1」上の A列の セルの列行の大きさを 画像 の縦横比 に合わせて 調整
2. 表示したい画像ファイルを A列の セル上に 全て配置
3. 別シート上に、表示したい大きさの画像 を配置
4. 3で配置した画像を選択、数式バー に 『=Sheet1!A1』 を入力し Enter
 

Sub Sample()
  Dim obj As Object
  Dim i As Long

  Set obj = Worksheets("Sheet3").Shapes(1).DrawingObject

  For i = 1 To 5  ' 5 は 配置した画像の 最終セルの 行位置
    obj.Formula = "Sheet1!A" & i
    DoEvents
    Application.Wait (Now + TimeValue("00:00:01"))
  Next
  Set obj = Nothing
End Sub

 
 
画像のみであれば、
Excel で作るより、Windows標準の ビデオエディター の 方がだいぶ楽でしょう。
3Dモデルをどうしても入れるなら、PowerPoint を使用した方が楽と思います。
 
Excel を使う理由は何でしょうか?

投稿日時: 22/05/09 16:28:21
投稿者: ip8bk

ご回答くださいました皆様ありがとうございます。
 
画像の作成はtaitani様が添付くださった内容と同様です。
 
グラフをパラパラ3〜4枚ほど流れる動画が作成できたらと思っております。
 
画像をpngに保存するところはExcelで作成しておりますが、動画はExcel以外でも大丈夫ですが、vbaで自動化したいです。
 
絵本のページは揃っていて、流れるような形で組み合わせるところで躓いております。
 
一通りご回答したつもりですが、漏れておりましたら、ご指摘くださいm(_ _)m

回答
投稿日時: 22/05/09 17:40:30
投稿者: taitani

引用:
グラフをパラパラ3〜4枚ほど流れる動画

 
とのことですので、
 
引用:
そうですね、以下のサイトが参考になると思います。
http://www.ken3.org/vba/backno/vba028.html

 
を参考に作成してみてください。

回答
投稿日時: 22/05/10 09:17:14
投稿者: Suzu

ip8bk さんの引用:
画像の作成はtaitani様が添付くださった内容と同様です。
 
グラフをパラパラ3〜4枚ほど流れる動画が作成できたらと思っております。
 
画像をpngに保存するところはExcelで作成しておりますが、動画はExcel以外でも大丈夫ですが、vbaで自動化したいです。

 
グラフですか?
最初の話にあった、
引用:
動画:MP4、WEBM、
3Dモデル:GLB、GLTF
この辺りは必要なくなったのでしょうか?
 
 
グラフとの事ですので、Excel の Chartオブジェクト の認識で良いでしょうか?
 
また、見せるのが、Excel でも Excel以外 でも 良い と言うことから、
パラパラ漫画(動画)として保存し、Movie として再生する必要はなく、
Excel上で、その様に見せれば良い と認識しました。
 
であれば、先に提示した手順の、「2.」を、画像から グラフ に読み替えればそのまま使用できます。
 
 
1. シート「Sheet1」上の A列の セルの列行の大きさを グラフの大きさに合わせて 調整
2. 表示したいグラフを A列の セル上(A1、A2、・・・)に 配置
3. 別シート(「Sheet2」)上に 「挿入」-「図」-「画像」 にて何でも良いので画像を挿入します
4. 3で配置した画像を選択、数式バー に 『=Sheet1!A1』 を入力し Enter
  
Sub Sample()
  Dim obj As Object
  Dim i As Long

  Set obj = Worksheets("Sheet2").Shapes(1).DrawingObject

  For i = 1 To 5  ' 5 は 配置した画像の 最終セルの 行位置
    DoEvents
    obj.Formula = "Sheet1!A" & i
    DoEvents
    Application.Wait (Now + TimeValue("00:00:01")) '1秒間隔で次の画像を表示
  Next
  Set obj = Nothing
End Sub

投稿日時: 22/05/10 10:47:56
投稿者: ip8bk

ご回答ありがとうございます。
説明不足がありましたので、取り急ぎご連絡させていただきます。
 

引用:
また、見せるのが、Excel でも Excel以外 でも 良い と言うことから、
パラパラ漫画(動画)として保存し、Movie として再生する必要はなく、
Excel上で、その様に見せれば良い と認識しました。

 
動画の作成はvbaで行い、再生はエクセルではなくアプリで動画再生したいと思います。
 

回答
投稿日時: 22/05/10 11:42:50
投稿者: simple

Excelは動画アプリ作成ソフトではありません。
そうしたことを求めるのは無駄なことではないですか?
 
"複数の画像を動画にする" などでGoogle検索してください。

回答
投稿日時: 22/05/10 12:09:12
投稿者: Suzu

引用:
動画の作成はvbaで行い、再生はエクセルではなくアプリで動画再生したいと思います。

 
 
画像ファイル を 集めて、パラパラ漫画(スライドショー)を MP3等の動画ファイル
として 作成したい。と言うことですよね。
 
そうなのであれば、Excel の機能ではなくなります。
 
VBAを使えば、オートメーション等で他のソフトを操作する事ができますが、
どの スライドショーソフトが オートメーション操作可能なのか判りませんので
動画作成の直接的な回答はできません。
(Adobe のソフトであれば、オートメーション対応してそうな気はしますが
 詳細は判りかねます)
 
 
スライドショー作成ソフトは、たいがいは 作成のひな型 があり、
それに、画像を指定すれば良いです。
 動画作成機能を含んでいるソフトであれば、そこから必要に応じ MP3等の動画とします。
 
 
MP3 等の 動画 として保存するのか
それとも、そのソフト上で、画像のままスライドショーとして実行するのか
 
2〜3枚のスライドショーを どのくらいのセット作りたいのか判りませんが
 
画像を保存するまで、VBAで出来ているなら、
フォルダ毎に分けてしまえば、スライドショー作成が楽なのではないでしょうか?
 
 
数十枚、数百枚のスライドショーなら MP3等の動画にするのも判りますが
2〜3枚 なら、
・PowerPoint
・スライドショーソフト
で十分と思います。

投稿日時: 22/05/10 12:26:51
投稿者: ip8bk

やはり難しいようですね。
2~3枚の組み合わせで1000以上作成したかったので、vbaで自動化を検討していましたが、vbaでは難しいようですので、もう少し待って解決策がご提案されないようでしたら、諦めたいと思います。

投稿日時: 22/05/10 14:24:16
投稿者: ip8bk

ご返信ありがとうございます。
形式をご連絡いたします。
 
動画:MP4、WEBM、
3Dモデル:GLB、GLTF
 
 

引用:
どんなアプリを使ってみてもらうんですか?

ファイルが再生できるソフトならなんでも大丈夫と考えております。

回答
投稿日時: 22/05/10 15:25:39
投稿者: Suzu

MP4 であれば PowerPoint で作成できるのでは?
 
1.「挿入」-「フォトアルバム」 にて、フォルダ/写真選択
2.「ファイル」-「エクスポート」-「ビデオの作成」
 
あとは、それを VBA にて実施。
 
 
初心者備忘録
指定したフォルダ内の画像ファイルを一括挿入するPowerPointマクロ
https://www.ka-net.org/blog/?p=8228
 
 
Qiita
PowerPoint VBA で 動画ファイルを作るときの注意
https://qiita.com/takebayashi0612/items/9d179ada3d531c137716
 
あたりを参考に。
必要なら、Excelからオートメーションで操作しても良いでしょう。

投稿日時: 22/05/11 10:55:46
投稿者: ip8bk

ご返信ありがとうございます。
皆様のご指導のおかげで何とか作成できそうですが、MP4に変換する以下のコードでエラーが発生します。
こちらがうまくいけばほぼ成功となりますので、お時間あるときに気になる点ございましたらご指導お願いいたします。
 
エラーが出ているコードとエラーメッセージはこちらです↓
objPPT.SaveAs filename:="sample1000", FileFormat:=39
 
実行時エラー'438':
オブジェクトは、このプロパティまたはメソッドをサポートしていません。
 

Sub sample()
    Dim ppApp As New PowerPoint.Application
    Dim ppPt As Presentation
    Dim ppSlide As Slide
    Dim ppShape As PowerPoint.Shape
    Dim ws As Worksheet
'    ppApp.Visible = True 'PowerPoint2007以前の場合は有効にしてください。
    Set ppPt = ppApp.Presentations.Open(ThisWorkbook.Path & "\sample.pptx")
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    For i = 1 To 2
        With ws
            .Range(Cells(1, i * 2 - 1), Cells(1, i * 2)).Copy
            'PasteSpeciaでエラーが出るときは、ここに待ちを作ります。
            Set ppSlide = ppPt.Slides(i) 'スライド番号を指定
            ppSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile, Link:=msoFalse
            Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count)
            ppShape.Top = Application.CentimetersToPoints(1) '上位置
            ppShape.Left = Application.CentimetersToPoints(1) '左位置
            ppShape.LockAspectRatio = msoTrue '縦横比を固定
            ppShape.Width = Application.CentimetersToPoints(30) '横幅
            Application.CutCopyMode = False
        End With
    Next
    Dim objPPT As Object
    Set objPPT = CreateObject("PowerPoint.Application")
    objPPT.SaveAs filename:="sample1000", FileFormat:=39
  
'    ppPt.Save
'    ppApp.Quit
    Set ppPt = Nothing
    Set ppApp = Nothing
End Sub

回答
投稿日時: 22/05/11 11:32:36
投稿者: Suzu

引用:
エラーが出ているコードとエラーメッセージはこちらです↓
objPPT.SaveAs filename:="sample1000", FileFormat:=39
 
実行時エラー'438':
オブジェクトは、このプロパティまたはメソッドをサポートしていません。

 
    Dim objPPT As Object
    Set objPPT = CreateObject("PowerPoint.Application")
    objPPT.SaveAs filename:="sample1000", FileFormat:=39
 
 objPPT は、アプリケーション です。
  SaveAsメソッド は、アプリケーションではなく、プレゼンテーション に対してのメソッドです。
 なので、エラーとなります。
 
 また、ここで 新たに PowerPointApplication を作成しようとしないでください。
 複数のプロセスを起動できない PowerPoint の仕様なので
 結果としては、同一のプロセスとなるのですが、
 
 Excel等だと、前に使っていた、ppApp と全く関係なくなります。
 
 ppPt.SaveAs 〜 で良いはずです。
 
 
テストを行ったコードがありましたので参考までにUPします。
動作保証や、解説は行いませんのであしからず。
Sub TEST()
  'Sheet1の A列 に入れたフォルダパスの Jpeg画像を
  'PPに貼り付け
  '切り替え時間1秒のスライドショーとして 写真と同じフォルダにTEST.MP4として出力

  Dim rng As Excel.Range

  Dim PP  As PowerPoint.Application
  Dim prs As PowerPoint.Presentation
  Dim sld As PowerPoint.Slide
  Dim shp As PowerPoint.Shape

  Dim FSO As Scripting.FileSystemObject
  Dim Fld As Scripting.Folder
  Dim Fil As Scripting.File

  Set PP = CreateObject("PowerPoint.Application")
  Set FSO = CreateObject("Scripting.FileSystemObject")

  For Each rng In Application.Intersect(Worksheets("Sheet1").UsedRange, Worksheets("Sheet1").Range("A:A"))
    If FSO.FolderExists(rng.Value) = True Then
      Set Fld = FSO.GetFolder(rng.Value)
      Set prs = PP.Presentations.Add
      For Each Fil In Fld.Files
        
        'JPEGファイルのみ処理
        Select Case LCase(FSO.GetExtensionName(Fil.Path))
          Case "jpg", "jpeg"
            Set sld = prs.Slides.Add(prs.Slides.Count + 1, ppLayoutBlank)
            sld.Select
            Set shp = sld.Shapes.AddPicture(Filename:=Fil.Path, LinkToFile:=False, SaveWithDocument:=True, Left:=0, Top:=0)
            With shp
              .LockAspectRatio = True '縦横比を固定

              '挿入した画像をスライドのサイズに合わせる
              If .Width > .Height Then
                .Width = prs.PageSetup.SlideWidth
              Else
                .Height = prs.PageSetup.SlideHeight
              End If

              .Select
            End With

            '画像をスライド中央に配置
            With PP.ActiveWindow.Selection.ShapeRange
              .Align msoAlignCenters, True
              .Align msoAlignMiddles, True
            End With
        End Select
      Next
      prs.CreateVideo Filename:=Fld.Path & "\TEST.mp4", DefaultSlideDuration:=1, VertResolution:=720, Quality:=80
      PP.Activate
      On Error Resume Next
      Do While PP.Presentations.Count > 0
        Application.Wait (Now + TimeValue("00:00:10"))  '10秒待機
        prs.Saved = False
        prs.Close
      Loop
      On Error GoTo 0
    End If
  Next

  PP.Quit
  Set shp = Nothing
  Set sld = Nothing
  Set prs = Nothing
  Set PP = Nothing

  Set Fil = Nothing
  Set Fld = Nothing
  Set FSO = Nothing
  MsgBox "終了"
End Sub

投稿日時: 22/05/11 12:38:28
投稿者: ip8bk

ご回答ありがとうございます。
下記コードでfalseになってしまいますが、A1セルの値と同じ名前のフォルダの有無を判別されているのでしょうか?
フォルダを作成してみましたが、trueになりません。どこのフォルダの中身を見ているのでしょうか??
 

If FSO.FolderExists(rng.Value) = True Then

回答
投稿日時: 22/05/11 14:34:40
投稿者: Suzu

フォルダが存在するか確認する
https://www.moug.net/tech/exvba/0060061.html

ご確認ください。

投稿日時: 22/05/11 15:19:50
投稿者: ip8bk

ご回答ありがとうございます。
基礎は理解しておりますが、今回のケースがフルパスではないように見えますので、理解できておりません。
 
また事前準備として、A列と同じ名前のフォルダを用意する必要がありますでしょうか?

回答
投稿日時: 22/05/11 16:22:15
投稿者: Suzu

引用:
今回のケースがフルパスではないように見えますので、理解できておりません。

 
今回のケース と言うのは
 ・ ip8bk さん が A列 に入れている 文字列 の事なのであれば、
   その内容は回答者には判りませんので その文字列を回答者が判る様にしてください。
 
 
 ・リンク先 のページ の例の中の
   TempDir = "D:\Test" これが 「フルパスでないように見える」のでしょうか?
 
   当方にとっては、フォルダのフルパス そのもの の認識です。
   ip8bk さん にとっての フルパス はどのようなものになりますか?
 
 
引用:
また事前準備として、A列と同じ名前のフォルダを用意する必要がありますでしょうか?

  'Sheet1の A列 に入れたフォルダパスの Jpeg画像を
  'PPに貼り付け
  '切り替え時間1秒のスライドショーとして 写真と同じフォルダにTEST.MP4として出力

投稿日時: 22/05/11 17:17:50
投稿者: ip8bk

ありがとうございます。
ようやく理解できました。大変遅くなり申し訳ございません。
 
しかし、依然と下記のコードのフルパスが正常に認識されずFalseになってしまいます。
 

 If FSO.FolderExists(rng.Value) = True Then

 
Office365の影響を受けている可能性はございますでしょうか?

投稿日時: 22/05/12 08:46:47
投稿者: ip8bk

失礼いたしました。
問題なく動作致しました。
 
あと運用にかんするご質問を2〜3して終了させていただきます(m_ _m)

トピックに返信