---------------------------------------------------------
Sub Load_Picture()
'ワークシート"ファイル名リスト"に記載された写真を"写真一覧"に読み込みます。

Worksheets("写真一覧").Select

XStart = Worksheets("ファイル名リスト").Cells(2, 4).Value 'X開始位置
XStep = Worksheets("ファイル名リスト").Cells(3, 4).Value 'Xステップ
XWidth = Worksheets("ファイル名リスト").Cells(4, 4).Value 'X列数
YStart = Worksheets("ファイル名リスト").Cells(2, 6).Value 'Y開始位置
YStep = Worksheets("ファイル名リスト").Cells(3, 6).Value 'Yステップ
YHight = Worksheets("ファイル名リスト").Cells(4, 6).Value 'Y行数

DataCount = 1

Do
DataRow = DataCount + 5
DataFolder$ = Worksheets("ファイル名リスト").Cells(DataRow, 1).Value
DataFilename$ = Worksheets("ファイル名リスト").Cells(DataRow, 2).Value
If DataFolder$ = "" Or DataFilename$ = "" Then Exit Do

'座標の計算
ActiveColumn = XStart + XStep * ((DataCount - 1) Mod XWidth)
ActiveRow = YStart + YStep * ((DataCount - 1) \ XWidth)

'表題の挿入
Cells(ActiveRow, ActiveColumn) = DataFilename$

'画像の挿入
Cells(ActiveRow + 1, ActiveColumn).Select
ActiveSheet.Pictures.Insert(DataFolder$ & DataFilename$).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 171#
Selection.ShapeRange.Width = 226.5

DataCount = DataCount + 1
Loop

Range("A1").Select


End Sub


Sub UnLoad_Picture()
'ワークシート"写真一覧"にある写真（およびオブジェクト）を全て削除します。

Worksheets("写真一覧").Select
ActiveSheet.Shapes.SelectAll
Selection.Delete

'ファイル名や見出しも削除します。
Cells.Select
Selection.ClearContents
Range("A1").Select

End Sub

'---------------------------------------------------------
画像を読み込んで縮小表示しているのはこの部分です。
ActiveSheet.Pictures.Insert(DataFolder$ & DataFilename$).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 171#
Selection.ShapeRange.Width = 226.5
３行目と４行目で縦横の大きさを指定しています。