みんなの「教えて（疑問・質問）」にみんなで「答える」Q&Aコミュニティ

プログラムの中の画像ファイル名の指定が悪いのだと思う。
あとの究明ぐらいは、質問者が、責任をもって、テストをやるべきだ。
ーー
なぜならば、
下記を実行してみると、小生の場合は、思い通りの画像が表示された。（一例ですが）。
ーーー
下記はＳｈｅｅｔ１のシートのＣｈａｎｇｅイベントに貼り付け。
標準モジュールへ貼り付け、ではないよ。
実行はＳｈｅｅｔのＣ４セルの値の変更。
メニューの実行（Ｆ５キー）ではないよ。
Private Sub Worksheet_Change(ByVal Target As Range)
'C4セルの値が変わったら
Const trgR As String = "C4" '地図通し番号を入力するセル
Const insR As String = "B16" '挿入画像の左上のセル
Const path As String = "Z:\サービス\チーム\ABC\データ\2019年\JPEG" 'ファイルの格納フォルダ
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
'MsgBox path & Target.Value & pic
fn = "C:\Users\xxxx\Pictures" & "\PC040626.JPG"　′xxxxはユーザー名を隠したもの。バックスラッシュの表示の部分は、￥です。
　　MsgBox fn
buf = Dir(fn)
' buf = Dir(path & Target.Value & pic)
If buf <> "" Then '入力したファイル名があるかチェック
'ActiveSheet.Pictures.Insert (path & Target.Value & pic)
ActiveSheet.Pictures.Insert (fn)
Else
MsgBox "指定したファイルがありません"
End If
End If
Target.Offset(1, 0).Select
End Sub

投稿日時 - 2019-07-03 09:50:50