画像をエクセルに貼り付けるマクロ
画像をエクセルに貼り付けるマクロ
複数の画像をエクセルに貼り付ける機会が多く、下記のマクロを利用しています。これは他人が作ったものでその人が今はいないため修正の仕方がわかりません。
これだとヨコに2個の画像で縦方向に画像が貼り付けられます。これをヨコに3個の画像で
縦方向に画像を貼り付けるようにしたいのですが、方法がわかりません。
お詳しい方どうかよろしくお願いします。
＜現在＞
１ ２
３ ４
５ ６
＜やりたいこと＞
１ ２ ３
４ ５ ６
７ ８ ９
Sub Insertpic()
Dim strFilter As String
Dim Filenames As Variant
Dim pic As picture
Dim sc As Range
Dim i As Long
Dim j As Long
Dim k As Long
'「ファイルを開く」ダイアログでファイル名を取得
strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
Filenames = Application.GetOpenFilename( _
FileFilter:=strFilter, _
Title:="画像の挿入(複数画像が選択できます）", _
MultiSelect:=True)
If Not IsArray(Filenames) Then Exit Sub
' 貼り付け開始セルを選択
'ActicveCellRange("C5").Select
' マクロ実行中の画面描写を停止
Application.ScreenUpdating = False
' 順番に画像を挿入
For i = LBound(Filenames) To UBound(Filenames)
Set pic = ActiveSheet.Pictures.Insert(Filenames(i))
'画像の大きさ指定
With pic.ShapeRange
.Height = 120#
.Width = 175#
.Rotation = 0#
End With
' 次の貼り付け先を選択
Select Case i Mod 2
Case 1 '奇数回目
ActiveCell.Offset(, 4).Select
Case 0 '偶数回目
ActiveCell.Offset(11, -4).Select
End Select
Set pic = Nothing
Next i
' 終了
Application.ScreenUpdating = True
MsgBox i - 1 & "枚の画像を挿入しました", vbInformation
End Sub
お礼
LoadPictureですね。有り難うございます。上手く動きました