Sub gazo()
Dim Row_No
Dim column_No
Dim i
Row_No = 1
column_No = 3
'FileSystemObjectを生成
Set ObjFS = CreateObject("Scripting.FileSystemObject")
'ファイル選択ダイアログの作成
With Application.FileDialog(msoFileDialogOpen)
'ファイルダイアログボックスから複数のファイルを選択を可能にする
.AllowMultiSelect = True
'フィルターの設定
.Filters.Clear
'拡張子をjpgに指定
.Filters.Add "JPGファイル", "*.jpg"
If .Show = -1 Then
'選択されたファイルパス、ファイル名の取得
For Each vrtSelectedItem In .SelectedItems
'セルを指定
'Cells(Row_No, column_No).Select
Cells(5, column_No).Select
'画像ファイルをセルに挿入
ActiveSheet.Pictures.Insert(vrtSelectedItem).Select
'縦横比を非継承
Selection.ShapeRange.LockAspectRatio = msoFalse
'選択した図形を設定
Selection.ShapeRange.Top = ActiveCell.Top
Selection.ShapeRange.Left = ActiveCell.Left
Selection.ShapeRange.Width = ActiveCell.Width
Selection.ShapeRange.Height = ActiveCell.Height
'列を1つ横へ
column_No = column_No + 3
'列が5つ移動したら、行を1つ下に移動
If column_No = 5 Then
column_No = 1
Row_No = Row_No + 1
End If
'次の画像を読み込む
Next vrtSelectedItem
Else
'キャンセルの場合、処理を終了する。
Exit Sub
End If
End With
End Sub
'------------------------------------------------------------------
'すべての画像がセル位置に自動で移動する
Sub 画像の位置移動()
Dim sp As Shape
For Each sp In ActiveSheet.Shapes
If sp.Type = msoPicture Then
sp.LockAspectRatio = msoFalse
sp.Top = sp.TopLeftCell.Top
sp.Left = sp.TopLeftCell.Left
sp.Height = sp.TopLeftCell.Height
sp.Width = sp.TopLeftCell.Width
End If
Next
End Sub