[[20190605100528]]　『VBA画像挿入「リンクされたイメージを表示できまａx（たかふみ）　ページの最後に飛ぶ

『VBA画像挿入「リンクされたイメージを表示できません」』（たかふみ）

お世話になります。
VBAの画像挿入についてご質問致します。
環境情報（VBA初心者。Excel2016 Win10）VBAは改めて勉強しようと思います・・。

◆経緯
(１)ネットから探り、「特定のセルが変更（入力）されたとき、別の指定セルに入力された名称と同じ名称の画像を指定のフォルダからエクセルに貼り付けする」という、VBAをエクセルシートに用意。
(２)前述VBAを使ってファイルを複数個別に「xlsx」で保存。
(３)しかし、後日「Pictures.Insert」ではリンク貼り付けになることを知る。
◆質問
１．前述でリンク貼り付けされた画像を、通常の画像として修正できないでしょうか。(２)によって既に幾つかファイルが独立しているためです。
２．「Pictures.Insert」を別の方法で、画像として貼り付けできないでしょうか。条件は、貼り付けセル位置と、縦横サイズが指定です。

下記、使用したコードです。

Private Sub Worksheet_Change(ByVal Target As Range) '画像自動挿入だけど関数は無効
Const trgR As String = "セル" '地図通し番号を入力するセル
Const insR As String = "セル" '挿入画像の左上のセル
Const path As String = "\\フォルダ\" 'ファイルの格納フォルダ
Const pic As String = ".jpg" '「.(半角)」＋ファイルの拡張子"
Dim shp As Shape

 Dim buf As String
    If Target.Address(0, 0) = trgR Then
        For Each shp In ActiveSheet.Shapes  '既に表示されている画像を削除する処理
             If Not Intersect(Range(insR), Range(shp.TopLeftCell, _
                        shp.BottomRightCell)) Is Nothing Then
                shp.Delete
            End If
        Next
        Range(insR).Select
        buf = Dir(path & Target.Value & pic)
        If buf <> "" Then  '入力したファイル名があるかチェック
            ActiveSheet.Pictures.Insert (path & Target.Value & pic)
        Else
            MsgBox "指定したファイルがありません"
        End If
    End If
    Target.Offset(1, 0).Select
 End Sub

どうぞ宜しくお願い致します。
※VBAを作る際に参考させていただいた質問があったのですが、失念してしまいました。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

ActiveSheet.Shapes.AddPicture を使ってみてください。第2引数にmsoFalse（リンクしない）、第3引数にmsoTrue（ブックと一緒に保存）を指定すれば良いです。
（???） 2019/06/05(水) 11:21

コメントありがとうございます。
ご案内頂いた「ActiveSheet.Shapes.AddPicture」調べてみました。
表面上は分かったのですが、前述のVBAを変更する際に、「指定セルが変更された場合」「セル内の値を参照に用いて引っ張るファイル名を指定」「既に表示された画像を削除処理」など、
どこをどう変えるべきか、理解できませんでした..。（応用できない）
全くのド素人で申し訳ないですが、ご教示いただけないでしょうか。
※参考にしたサイト「https://tonari-it.com/excel-vba-shapes-addpicture/」
（たかふみ） 2019/06/05(水) 11:43

 VBAのお勉強で作ってみました(^^)
 自分の環境下では動きましたが…（Excel2010、windows7）

 ↓参考にしたサイト
 https://www.moug.net/tech/exvba/0120020.html

 Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range) '画像自動挿入だけど関数は無効

    Const trgR As String = "セル" '地図通し番号を入力するセル
    Const insR As String = "セル" '挿入画像の左上のセル
    Const path As String = "\\フォルダ\" 'ファイルの格納フォルダ
    Const pic As String = ".jpg" '「.(半角)」＋ファイルの拡張子"
    Dim shp As Shape
    Dim buf As String
    Dim mypic As Shape '追加

    If Target.Address(0, 0) = trgR Then
        For Each shp In ActiveSheet.Shapes  '既に表示されている画像を削除する処理
            If Not Intersect(Range(insR), Range(shp.TopLeftCell, _
                shp.BottomRightCell)) Is Nothing Then
                shp.Delete
            End If
        Next
        Range(insR).Select
        buf = Dir(path & Target.Value & pic)
        If buf <> "" Then  '入力したファイル名があるかチェック
'            ActiveSheet.Pictures.Insert (path & Target.Value & pic)
            Set mypic = Me.Shapes.AddPicture(Filename:=path & Target.Value & pic, _
                                             linktofile:=msoFalse, _
                                             savewithdocument:=msoTrue, _
                                             Left:=Range(insR).Left, _
                                             Top:=Range(insR).Top, _
                                             Width:=0, _
                                             Height:=0)
            With mypic
                .ScaleHeight factor:=1, relativetooriginalsize:=msoTrue
                .ScaleWidth factor:=1, relativetooriginalsize:=msoTrue
            End With
        Else
            MsgBox "指定したファイルがありません"
        End If
    End If
    Target.Offset(1, 0).Select

End Sub

（虎） 2019/06/05(水) 12:02

コメントを有難うございます。
ご案内頂いたコードで無事挿入できました。
お勉強ついでに、とのことですが元まで流用いただき非常に助かりました!!
???様、虎様、ご回答いただきどうも有難うございました。
今後とも宜しくお願い致します。

（たかふみ） 2019/06/05(水) 13:32

コメント返信：

[ 一覧(最新更新順) ]

[[20190605100528]] 『VBA画像挿入「リンクされたイメージを表示できまａx（たかふみ） ページの最後に飛ぶ

[[20190605100528]]　『VBA画像挿入「リンクされたイメージを表示できまａx（たかふみ）　ページの最後に飛ぶ