お世話になります。
エクセルで工事写真を整理していますが、結合セルB2:B19、B20:B38....と19行おきに写真を貼り付けるセルが
有ります。
これに一括で写真を取り込もうとして、Web上のコードを参考にして以下のコードを作成しましたが、セルのサイズにならなくて小さい画像が張り付いてしまって困っています。
どこに原因があるのでしょうか。ご教授よろしくお願いします。
Sub 画像一括取込()
Dim mySp As Object
Dim myAD1 As String
Dim myAD2 As String
Dim i As Integer
Dim fName, pict As Picture
If ActiveCell.Value <> "余 白" Then
Exit Sub
End If
fName = Application.GetOpenFilename("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , MultiSelect:=True)
Application.ScreenUpdating = False
'===============画像の掃除
For Each mySp In ActiveSheet.Shapes
myAD1 = mySp.TopLeftCell.MergeArea.Address
myAD2 = Selection.Address
If myAD1 = myAD2 Then mySp.Delete
Next
If IsArray(fName) Then
For i = 1 To UBound(fName)
Set pict = ActiveSheet.Pictures.Insert(fName(i))
pict.TopLeftCell = ActiveCell
pict.Width = ActiveCell.Width
pict.Height = ActiveCell.Height
ActiveCell.Offset(19, 0).Activate
Next i
End If
Application.ScreenUpdating = True
End Sub