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

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

投稿日時 - 2019-07-02 19:56:11

QNo.9631285

すぐに回答ほしいです

質問者が選んだベストアンサー

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

お礼

imogasi様

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

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

投稿日時 - 2019-07-06 10:01:31

ANo.3

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

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

投稿日時 - 2019-07-02 21:22:12

お礼

kkkkkm様

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

投稿日時 - 2019-07-06 10:02:31

ANo.1

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

投稿日時 - 2019-07-02 20:46:17

お礼

oboroxx様

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

投稿日時 - 2019-07-06 10:03:23

あなたにオススメの質問