Excelで文字列に対応する図を呼び出し挿入

質問

zap35様のコードを参考に、
各シートのC4セルに入っている固有の番号と一致する画像ファイルを参照し
B16セルに画像を表示したいと考えています。

マクロを組んでいるエクセル格納
Z:\サービス\チーム\ABC\データ\2019年

画像ファイルはエクセルの下位にフォルダ格納
Z:\サービス\チーム\ABC\データ\2019年\JPEG

★C4セルに記入の文字列と同じファイル名にし格納しているものの、
"指定したファイルがありません"と表示されてしまいます。
原因がわからず、ご教示いただけますでしょうか。

よろしくお願いいたします。

Private Sub Worksheet_Change(ByVal Target As Range)
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
　　　　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

回答No.3

imogasi · ベストアンサー

プログラムの中の画像ファイル名の指定が悪いのだと思う。
あとの究明ぐらいは、質問者が、責任をもって、テストをやるべきだ。
ーー
なぜならば、
下記を実行してみると、小生の場合は、思い通りの画像が表示された。（一例ですが）。
ーーー
下記はＳｈｅｅｔ１のシートのＣｈａｎｇｅイベントに貼り付け。
標準モジュールへ貼り付け、ではないよ。
実行はＳｈｅｅｔのＣ４セルの値の変更。
メニューの実行（Ｆ５キー）ではないよ。
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

お礼

imogasi様

ありがとうございます。
上記コードではすべてのシートに反映できなかったので、
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
のように変更し、すべてのシートに反映することができました。

残るは画像のサイズの指定のみです。
また質問させていただくかもしれませんが、何卒よろしくお願いいたします。

回答No.2

kkkkkm

そういう時は
Debug.Print path & Target.Value & pic
としてイミディエイトウィンドウに結合の結果を表示し、正しいファイルのフルパスが形成されているかどうか確かめてみましょう。

お礼

kkkkkm様

ご回答ありがとうございます。
そのようにしてみます。

回答No.1

oboroxx

良くはわかりませんが、path変数の最後に￥記号がないから、変なファイル名になっているだけではないかな。

お礼

oboroxx様

ご回答ありがとうございます。
確認します。