Excelエクセルの小ネタ「写真整理」VBAマクロ使用による自動貼付方法(３パターン)

選択した写真を自動で貼り付けるエクセルファイルを
作成しました。VBAを使用しています。
独学で作成しているもので、効率的と
は言えないとは思いますが、皆さんの参考になれば
幸いです。
下記に3パターン記載しましたのでコピペして
使用してください。

‘————————————————

Sub 写真貼付1name() ‘ファイル名付き

‘ファイル読み出し用変数
Dim filename As Variant

‘写真読み込み用変数
Dim pic As Shape

‘ファイルを纏めて読み込む
filename = Application.GetOpenFilename(“JPG,*.jpg”, MultiSelect:=True)

‘filenameの配列か確認
If IsArray(filename) Then

‘ファイル選択数分繰り返す
For i = 1 To UBound(filename)

‘ファイル名表示
ActiveCell.Offset = filename(i)

‘オブシェクト名を省略
With ActiveCell

‘写真のサイズをセルの大きさに合わせて貼付け
Set pic = ActiveSheet.Shapes.AddPicture(filename:=filename(i), linktofile:=False, savewithdocument:=True, _
Left:=.Left + 2, Top:=.Top + 2, Width:=.MergeArea.Width – 4, Height:=.MergeArea.Height – 4)
End With

‘セルの貼り付け位置を設定
ActiveCell.Offset(1, 0).Activate

Next i

End If

End Sub

‘—————————————————–
Sub 写真貼付22()　’2列表示

‘ファイル読み出し用変数
Dim filename As Variant
Dim t As Long

‘写真読み込み用変数
Dim pic As Shape

‘ファイル読み込み
filename = Application.GetOpenFilename(“JPG,*.jpg”, MultiSelect:=True)

‘filenameの配列か確認
If IsArray(filename) Then

‘ファイル選択数分繰り返す
For i = 1 To UBound(filename) Step 2 ‘2枚=2、3枚=3

For ii = 1 To 2 ‘行方向枚数分繰り返し

‘オブシェクト名を省略
With ActiveCell
t = t + 1 ‘henkou
‘写真のサイズをセルの大きさに合わせて貼付け
Set pic = ActiveSheet.Shapes.AddPicture(filename:=filename(t), linktofile:=False, savewithdocument:=True, _
Left:=.Left + 2, Top:=.Top + 2, Width:=.MergeArea.Width – 4, Height:=.MergeArea.Height – 4)
End With

‘貼付けセル位置を設定
ActiveCell.Offset(0, 1).Activate ‘列方向にアクティブセルを移動(行方向,列方向)
If t = UBound(filename) Then GoTo sub2 ‘写真が最終の時終了させる

Next ii

ActiveCell.Offset(1, -2).Activate ‘行方向にアクティブセルを移動(行方向,列方向)

Next i
sub2:

End If

End Sub

‘———————————————————–
Sub 写真貼付33()　’3列表示

‘ファイル読み出し用変数
Dim filename As Variant
Dim t As Long

‘写真読み込み用変数
Dim pic As Shape

‘ファイルを纏めて読み込む
filename = Application.GetOpenFilename(“JPG,*.jpg”, MultiSelect:=True)

‘filenameの配列か確認
If IsArray(filename) Then

‘ファイル選択数分繰り返す
For i = 1 To UBound(filename) Step 3 ‘step　2枚=2、3枚=3