ExcelのVBAで、複数の画像を一括で貼り付けます。VBAのコード好きではないですが、仕方ない。
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.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
コメント