エクセルに画像挿入

質問

以前の投稿で下記のようなVBAを拝見しました。
実行するとＡ列に画像ファイル名、Ｂ列に画像が縦に配置されます。
これを横に配置するにはどうすればいいのでしょうか？
初心者なので質問不足かもしれませんがよろしくお願いします。

Sub PictAdd()
Dim pict As Shape, r As Range

With Application.FileSearch
　.NewSearch
　.LookIn = ThisWorkbook.Path
　.SearchSubFolders = False
　.Filename = "*.jpg"
　If .Execute() > 0 Then
　　For i = 1 To .FoundFiles.Count
　　　Set r = ActiveSheet.Range("B" & i)
　　　Set pict = ActiveSheet.Shapes.AddPicture _
　　　　　　(.FoundFiles(i), msoTrue, msoFalse, _
　　　　　　 r.Left, r.Top, r.Width, r.Height)
　　　　　　pict.OnAction = "PictClick"
　　　　　　r.Offset(0, -1).Value = Dir(.FoundFiles(i))
　　Next i
　End If
End With
　Columns(1).EntireColumn.AutoFit
End Sub

回答No.2

imogasi · ベストアンサー

前の回答は上級者向けのところがあります。
少し違った方向から（マクロの記録を応用して）やってみます。
まず列方向に写真を増やすのにはスクロールなどの面（見やすいという）から限度が有ると思います。
それで１０行ｘ１０列を考えました。１０列を変えることはコード上
簡単です。
--
前段階学習テスト１
標準モジュールに
Sub test01()
k = 1
For i = 1 To 10
For j = 1 To 10
Cells(k, j) = (i - 1) * 10 + j
Cells(k + 1, j) = "p" & ((i - 1) * 10 + j)
Next j
k = k + 2
Next i
End Sub
をコピペして実行すると、上行に番号、下行には、写真の代わりに、P+番号が出ます。
最終的に、番号のセルにはファイル名、P+番号のセルには写真を表示します。
ーー
前段階学習テスト２
次に番号セルにファイル名を表示してみます。
(ファイルを指定するところは、質問者の実情に合わせて変えること）
Sub test02()
k = 1
MyFilename = Dir("C:\Documents and Settings\XXXX\My Documents\My Pictures\YYYY\*.jpg")
For i = 1 To 10
For j = 1 To 10
' MsgBox Myfilename
Cells(k, j) = MyFilename
Cells(k + 1, j) = "p" & ((i - 1) * 10 + j)
MyFilename = Dir()
If MyFilename = "" Then GoTo e01
Next j
k = k + 2
Next i
e01:
End Sub
ーー
最後に挿入ー図ーファイルから・・の操作のマクロの記録を参考に
下記にします。
(ファイルを指定するところは質問者の実情に合わせること）
Sub test03()
Application.ScreenUpdating = False
k = 1
MyFilename = Dir("C:\Documents and Settings\xxxx\My Documents\My Pictures\YYYY\*.jpg")
For i = 1 To 5 '１０を５に減らした
For j = 1 To 10
' MsgBox Myfilename
'---
Cells(k, j) = MyFilename
Cells(k + 1, j).RowHeight = 50
Cells(k + 1, j).ColumnWidth = 13
ActiveSheet.Pictures.Insert( _
"C:\Documents and Settings\XXXX\My Documents\My Pictures\YYYY\" & MyFilename).Select
Selection.Top = Cells(k + 1, j).Top '以下はセルのサイズに合わせる
Selection.Left = Cells(k + 1, j).Left
Selection.Height = Cells(k + 1, j).Height
Selection.Width = Cells(k + 1, j).Width
MyFilename = Dir()
If MyFilename = "" Then GoTo e01
Next j
k = k + 2
Next i
e01:
Application.ScreenUpdating = True
End Sub
ーーーー
上記でコードのコメントで、'１０を５に減らした
のところは、エクセルの処理が重くなるので、一遍に増やさず、どれぐらい可能かやってみてください。
前の質問のご回答でやると、いくつぐらい画像を読み込めましたか。
小生は写真で７０ぐらいまでは読み込みました。余り増やすとHangUp
する可能性があります。
エクセルでこういうサムネイル的表示的なことをやるのは向いてないのかも知れないと思いました。

お礼

ありがとうございます。
MyFilename=*jpg
で動いたのですが、下記のところでひかっかりました。
＆の前の\YYYY\にはエクセルファイルか画像ファイルかどちらか
を入れるのでしょうか？
C:\Documents and Settings\XXXX\My Documents\My Pictures\YYYY\ & MyFilename).Select
それと2007ではWithは動かないのでしょうか？

補足

たびたびすみません。m(_ _)m
Sub test01()
For i = 1 To 10
For j = 1 To 10
この1列から10列、1行から10行に配置を
1列、3列、5列、7列
そして、1行、3行、5行、7行
に配置の場合どうすればいいのでしょうか？

回答No.1

redfox63

Set r = ActiveSheet.Range("B" & i)
を
Set r = ActiveSheet.Range("A2").Offset(0,i-1)

　　r.Offset(0, -1).Value = Dir(.FoundFiles(i))
を
　　r.Offset(-1, 0).Value = Dir(.FoundFiles(i))
としてみましょう

ただしExcel2003以前のバージョンでは 256列までしかありませんので
これを超えた場合エラーになるでしょう

お礼

ありがとうございます。
感動しました。