ここから本文です

お世話になります。

get********さん

2019/2/1020:42:35

お世話になります。

Excel 2016 で Pictures.Insert メソッドを使用して図をワークシートに挿入すると図がリンク オブジェクトとして挿入されるのでAddpictureを使いたいのですが下記のコードをどう改造するか教えてください。
よろしくお願いします。

Sub 画像一括取込()

Dim i As Integer
Dim fName, pict As Picture



fName = Application.GetOpenFilename("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , MultiSelect:=True)

Application.ScreenUpdating = False


If IsArray(fName) Then
For i = 1 To UBound(fName)
Set pict = ActiveSheet.Pictures.Insert(fName(i))
pict.TopLeftCell = ActiveCell
pict.Width = Selection.Width
pict.Height = Selection.Height
ActiveCell.Offset(19, 0).Activate
Next i
End If


Application.ScreenUpdating = True
End Sub

閲覧数:
31
回答数:
1
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

taihenda****さん

2019/2/1110:13:32

Sub 画像一括取込()
Dim i As Integer
Dim fName, pict As Shape
fName = Application.GetOpenFilename("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , MultiSelect:=True)
Application.ScreenUpdating = False
If IsArray(fName) Then
For i = 1 To UBound(fName)
Set pict = ActiveSheet.Shapes.AddPicture( _
FileName:=fName(i), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Selection.Left, _
Top:=Selection.Top, _
Width:=Selection.Width, _
Height:=Selection.Height)
ActiveCell.Offset(19, 0).Activate
Next i
End If
Application.ScreenUpdating = True
End Sub

質問した人からのコメント

2019/2/11 12:47:23

早速のご回答、ありがとうございます。

いろいろ悩んでいたのが嘘のように、思い通りの動作をするようになりました。
ありがとうございました。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる