dポイントプレゼントキャンペーン実施中!

超初級者ですよろしくお願い申し上げます。

下記は、マクロの自動記録で任意のフォルダを指定してマクロ記録で写真を張り付けるマクロです。
自動記録の場合、リンクとして挿入されるようで、環境が変わると画像がリンク切れになります。

それで、調べると、Shapes.AddPictureメソッドにしないとだめみたいのですが
どうしたらいいのでしょうか。
====================================
Sub 図面貼り付け()
Dim folderPath As String

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then folderPath = .SelectedItems(1)
End With
If folderPath = "" Then Exit Sub

Range("B11:F41").Select
ActiveSheet.Pictures.Insert("D:\xlsx\tesuto\output_1.jpg").Select
Selection.ShapeRange.IncrementLeft 17.25
Selection.ShapeRange.IncrementTop 15.75
Range("G11:K41").Select
ActiveSheet.Pictures.Insert("D:\xlsx\tesuto\output_2.jpg").Select
Selection.ShapeRange.IncrementLeft 19.5
Selection.ShapeRange.IncrementTop 14.25
End Sub

A 回答 (1件)

こんにちは、


If folderPath = "" Then Exit Sub
Range("B11:F41").Select
ActiveSheet.Pictures.Insert("D:\xlsx\tesuto\output_1.jpg").Select
Selection.ShapeRange.IncrementLeft 17.25
Selection.ShapeRange.IncrementTop 15.75
を書き直すと

If folderPath = "" Then Exit Sub
Range("B11:F41").Select
ActiveSheet.Shapes.AddPicture _
Filename:=folderPath & "\output_1.jpg", _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Selection.Left + 17.25, _
Top:=Selection.Top + 15.75, _
Width:=-1, _
Height:=-1 'Selection.Width Selection.Height
こんな感じですかね。
IncrementLeft 17.25は、Selection.Left + 17.25で良いと思います。
また、サイズに関しては、設定する必要があります。
取敢えず、Width:=-1 は、元画像のサイズで貼り付けられます。Selection.Widthとすると選択範囲の巾サイズ
あと、folderPathを作成しているのに反映されていませんので、勝手に反映させました。
同様にoutput_2.jpgに対して書き加えれば良いと思いますが、サイズに関しては不明なので設定してください。
    • good
    • 0
この回答へのお礼

早速の回答ありがとうございました。

おかげさまでうまくいきました。

お礼日時:2020/09/07 16:39

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A