【エクセルマクロVBA】写真のスライドショーしたい

質問

毎日100枚の写真が、ある特定のフォルダーに保存されます。
これらは、一日経つと、自動で削除されます（バッチファイルで）

これらの写真を、エクセルに取り込んで、
簡単に閲覧できるようにしたいのです。

写真を１０0枚挿入するマクロは書けるのですが、
その挿入した写真をどのように集め、スライドショーにするか、という
方法について悩んでいます。

コードは自分で調べるので、
どのような仕組みにしたらいいか、知恵をお貸し頂けますでしょうか？

例えば：

(1)ユーザーフォームを使う
(2)フォトビューアーをエクセルで立ち上げる
(3)スピンボタンを使う
(4)スライドショーにしないで、ワークシートに順番に表示
※できれば、この方法は避けたい。写真の数が多いので・・・

よろしくお願いします・・・

回答No.8

real beatin（@realbeatin） · ベストアンサー

No.1お礼欄への返信です。
大体は私が試していたのと同じなのですが、
ポイントは、フォルダを定義しておいて、「フルパスを格納する」ことと、
「i を 0 に戻す」ところぐらいです。★参考まで。

Option Explicit

Dim i As Long
Dim aryPict() As String

Private Sub UserForm_Initialize()
Dim ShashinName As String
Const S_DIR = "C:\Users\user1\Desktop\FolderName\"　'　★

　　ShashinName = Dir(S_DIR & "*.jpg")　'　★

　　' ' ★
　　Do While ShashinName <> ""
　　　　ReDim Preserve aryPict(i)
　　　　aryPict(i) = S_DIR & ShashinName　'　★
　　　　i = i + 1　'　★
　　　　ShashinName = Dir()
　　Loop

　　i = 0　'　★
　　Me.Image1.Picture = LoadPicture(aryPict(i))
End Sub

お礼

ありがとうございます！
「i を 0 に戻す」ことで、一番最初の写真を見せるわけですね！
これをしないと、上手くいきませんね。
週末にゆっくりと、
もっと細かいところを勉強させて頂きたいと思います。
今回はこれで閉じさせて頂きます。
ありがとうございました。

回答No.7

imogasi

＃６です。
エクセルＶＢＡでシート（下記コード例ではＳｈｅｅｔ１）を台紙と考えて、その上に写真を１枚づつ（同じ場所に）持ってきます。
次の写真に変わるまでの物理的時間を設定する方法もあるが、見ている人の自由になる方がよいと思って、ＥＳＣキーで次へ進める方法にしました。
考えている写真群は、１つの（同じ）フォルダにあるものとします。拡張子はＪＰＧの例です。
標準モジュールに
Sub test05()
Worksheets("Sheet1").Activate
DoEvents
'--表示用テキストボックス　’Ｍｓｇｂｏｘの表示位置は指定できないので、テキストボックスを使う
Set txtB = ActiveSheet.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=10, _
Top:=10, _
Width:=250, _
Height:=20)

'用意のメッセージ
txtB.TextFrame.Characters.Text = "写真を出します ESCキー"
'--
Set objFSO = CreateObject("Scripting.FileSystemObject") 'FileSystemObject
Worksheets("Sheet1").Activate 'Sheet1に写真を出す
strPath = "C:\Users\ＸＸＸ\Pictures\" 'フォルダ指定。ｘｘｘは自分の場合に変えること
'--画像ファイルを挿入し、変数myShapeに格納
For Each objfile In objFSO.getfolder(strPath).Files
'MsgBox objfile.Name
' MsgBox objFSO.GetextensionName(objfile)
If objFSO.GetextensionName(objfile) = "JPG" Then
'MsgBox "写真＝" & objfile.Name
Set myshape = ActiveSheet.Shapes.AddPicture( _
Filename:=objfile, _
LinkToFile:=True, _
SaveWithDocument:=False, _
Left:=100, _
Top:=50, _
Width:=550, _
Height:=430)

End If

DoEvents

waitTime = TimeSerial(0, 0, 10)
Application.Wait waitTime
no = no + 1
txtB.TextFrame.Characters.Text = "次の写真に行きます 番号　" & no & "　ESCキーを押せ"
Set myshape = Nothing
Next objfile
Worksheets("Sheet1").DrawingObjects.Delete
MsgBox "終りました"
End Sub
ＶＢＥ画面でＦ５キーを押して、実行が始まると、ワークシートＳｈｅｅｔ１の画面をマウスで選択して切り替え、ＥＳＣキーを何度か押して、第１写真が現れたら、その後は、その１枚の写真を見終わったら、ＥＳＣキーを押す。すると次の写真が現れると思う。
最後まで繰り返す。
ーー
苦労した点があり、もし不都合があれば、この回答を無視してください。

お礼

まずユーザーフォームでチャレンジして、
その後見てみます。ありがとうございます・・・

回答No.6

imogasi

エクセルを使わず、「パワーポイント」を使えば、どうでしょう。
問題は、このソフトを入れているかだが。
小生の場合、パソコンを買い替えたとき、ワードエクセルで最低あればと思っていたが、パワポもついてきた。質問者のパソコンにも入ってないですか。購入しても１万５千円ぐらいのようだ（ダウンロード版）。
エクセル互換（や無料）ソフトにも、プレゼンテーションソフトとして、パワポ相当のソフトは無いですか。
パワポＶＢＡも、最近はＷＥＢの記事も充実してきて、したいことに近いものが探せると思う。
質問者がお若い方なら（また仕事を持っている人らしいから）、パワポを勉強しておくことも、今後役立つと思う。

お礼

今回はエクセルでやる必要があります。
違う視点の提供ありがとうございます

回答No.5

real beatin（@realbeatin）

No.1です。一応スライドショーの設計、触れておきます。
例えば、
UserFormをクリックするとスライドショーの開始/終了を
トグルで切り替えるようなやり方としては、

コードモジュール（UserForm1）
　モジュールの宣言部（Declarations）に
　　　Private flg As Boolean　'　... スライドショーのOn/Off

　Private Sub UserForm_Click()
　　flg = Not flg
　　If flg Then SlideFore

　Private Sub SlideFore()
　　　DateAdd関数でNowのｎ秒後を日付型変数に格納
　　　Do（ループ） flgがTrueの間、、
　　　Nowが変数に格納した時刻以上であれば、
　　　CommandButton1_Click を実行。
　　　DateAdd関数でNowのｎ秒後を変数に格納
　　　間にDoEventsを挟んでおく
　　　... Loop

とか。やり方は色々あります。
UserForm_Clickよりもボタンがよければボタンでもいいです。
以上です。

回答No.4

kkkkkm

(3)スピンボタンを使う
もしくは通常のボタンを2個作って進む戻るにする
で、ファイル名は最初に一覧を配列変数に保存しておき、ボタンが押されるたびにワークシートに画像を表示
もう一個ボタンを作りそのボタンを押すと一定時間(どこかのセルで時間設定ができるといいと思います)ごとに次々と画像を表示する(いわゆるスライドショーですね)
ストップボタンもあったほうがいいですね。

お礼

回答ありがとうございます

回答No.3

ushi2015

こんにちは、No2です。
ループする際はTimerで一定時間経過する毎に切り替えるようにする
という事で。

回答No.2

ushi2015

こんにちは
挿入した写真が重なっていなければ、各写真をループして左上のセルを
プロパティで調べて、そのセルに
Application.GoTo そのセル, True
してもいいかも。
試した事ないですけど・・・

お礼

ありがとうございます

回答No.1

real beatin（@realbeatin）

こんにちは。

> コードは自分で調べるので、
> どのような仕組みにしたらいいか ...

ユーザーフォームの例で。

デザイン
　UserForm1
　　> Image1 ... 写真表示用
　　> CommandButton1 ... スライド 戻る
　　> CommandButton2 ... スライド 送る

コードモジュール（UserForm1）
　モジュールの宣言部（Declarations）に
　　　Private aryPict() As String　'　... 写真のフルパスを配列で
　　　Private i As Long　'　... 現在表示中の写真の配列内インデックス

　Private Sub UserForm_Initialize()
　　　"ある特定のフォルダー"を変数または定数に
　　　Dir()関数とDo Loopで、カウンタで数を数えながら、
　　　配列aryPict()をRedim Preserveしながら、
　　　写真へのフルパスを格納していく。
　　　終わったら、（i = 0 という条件で）
　　　Me.Image1.Picture = LoadPicture(aryPict(i))

　Private Sub CommandButton1_Click()　'　スライド 戻る
　　i = i - 1
　　If i < 0 Then i = UBound(aryPict)
　　Me.Image1.Picture = LoadPicture(aryPict(i))

　Private Sub CommandButton1_Click()　'　スライド 送る
　　i = i + 1
　　If i > UBound(aryPict) Then i = 0
　　Me.Image1.Picture = LoadPicture(aryPict(i))

※　一応、LoadPictureした後は、Me.Repaint、した方が無難かと。

大体、こんな感じです。
因みにスピンボタンを使うメリットを私は感じませんので、
Image1を中央に配し、両脇に一つずつCommandButtonをおくようなデザインです。
もし、ボタンが写真に少し被っても良ければ
　UserForm1 ... 写真表示用
　　> Label1 （背景透明化）... スライド 戻る
　　> Label2 （背景透明化）... スライド 送る
みたいなのもスマートで恰好いいかも、です。
また、単方向のスライドで良かったら、ボタンなしにして、
Image1やUserForm1をクリックしたら送る、という仕様もアリです。
解らない処あれば、遠慮なく、、、。

お礼

ご回答ありがとうございます。

コードは自分で調べると言ったのですが、
ちょっと難しかったので（＞＜）、質問させて下さい・・・

下記のコード（フォームの部分だけ）では上手く行きません。
ファイルが見つかりません、というエラーになります。
どこが間違っているか、もしよければ教えて下さい。。。

Option Explicit

Dim i As Long
Dim ShashinName As String
Dim arypict() As String

Private Sub UserForm_Initialize()

ShashinName = Dir("C:\Users\user1\Desktop\FolderName\*.jpg")

ReDim arypict(0)

Do While ShashinName <> ""

i = UBound(arypict) + 1
ReDim Preserve arypict(i)
arypict(i) = ShashinName

ShashinName = Dir()

Loop

Me.Image1.Picture = LoadPicture(arypict(i))

End Sub