（VBA実験）Excelに自動で複数画像貼り付け

Excelの別記事：　セルをmmで指定し正方形にする

動画で説明

コード

選択画面出てきたら、画像を複数選択してください。（CTRL+クリックで選択できます）

Sub img()
    Dim myFil As FileDialog
    Dim myPics As Variant
    Dim ct As Long
    
    ct = 1
    ' 貼り付ける画像の選択
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True  '//複数選択OK
        .Filters.Add "*.png;*.jpg", "*.png;*.jpg", 1
        .Show
        
        For Each myPics In .SelectedItems
            Call picInsert(myPics, ct)  '//関数
            ct = ct + 1
        Next
    End With
End Sub

Public Function picInsert(dt, ct)  'pic name data, number cnt
       'ActiveSheet.Pictures.Insert uPic
    With Sheets(1).Pictures.Insert(dt)   '// 画像を入れたいシート・ナンバー
        .Top = Cells(3 + (ct - 1) * 20, 2).Top
        .Left = Cells(3 + (ct - 1) * 20, 2).Left
        .Width = Range(Cells(3, 2), Cells(3, 7)).Width
    End With
End Function

With Application.FileDialog(msoFileDialogFilePicker)

msoFileDialogFilePicker	ユーザーがファイルを選択
msoFileDialogFolderPicker	ユーザーがフォルダーを選択できます。
msoFileDialogOpen	ユーザーがファイルを開くことができます。
msoFileDialogSaveAs	ユーザーがファイルを保存できます。

～.Show ダイアログ起動

Set uFil = Application.FileDialog(msoFileDialogFilePicker)
    uFil.Show
    MsgBox uFil.SelectedItems(1)
    

uFil.Filters.Add “説明” , “拡張子” , 1 フィルタ何番目に表示するか

 uFil.Filters.Add "*.png;*.jpg", "*.png;*.jpg", 1

画像ファイルのみ表示するようにする。

戻り値　　開くボタン＝-1　キャンセル＝0

With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "*.png;*.jpg", "*.png;*.jpg", 1
        num = .Show
        If num = -1 Then
            uPic = .SelectedItems(1)
        End If
End With
MsgBox num

.AllowMultiSelect = True　　画像複数選択

With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "*.png;*.jpg", "*.png;*.jpg", 1
        num = .Show
        If num = -1 Then
            uPic = .SelectedItems(1)
            uPic2 = .SelectedItems(2)
        End If
End With
MsgBox uPic
MsgBox uPic2

画像を挿入する

アクティブシートのアクティブセル（左上）を起点に画像入れる。

ActiveSheet.Pictures.Insert ""

シートを指定する

Sheets(2).Pictures.Insert ""

sheet2に入れます。

シート指定＋画像の大きさ指定

With Sheets(2).Pictures.Insert(uPic)
        .Top = Range("C3").Top
        .Left = Range("C3").Left
        .Width = Range("C3:G3").Width
End With