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