• ベストアンサー
  • すぐに回答を!

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

  • 質問No.9631285
  • 閲覧数92
  • ありがとう数3
  • 気になる数0
  • 回答数3
  • コメント数0

お礼率 92% (12/13)

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
  • ベストアンサー

ベストアンサー率 28% (4489/15985)

プログラムの中の画像ファイル名の指定が悪いのだと思う。
あとの究明ぐらいは、質問者が、責任をもって、テストをやるべきだ。
ーー
なぜならば、
下記を実行してみると、小生の場合は、思い通りの画像が表示された。(一例ですが)。
ーーー
下記は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
お礼コメント
sachiko555

お礼率 92% (12/13)

imogasi様

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

残るは画像のサイズの指定のみです。
また質問させていただくかもしれませんが、何卒よろしくお願いいたします。
投稿日時:2019/07/06 10:01

その他の回答 (全2件)

  • 回答No.2

ベストアンサー率 53% (525/983)

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

お礼率 92% (12/13)

kkkkkm様

ご回答ありがとうございます。
そのようにしてみます。
投稿日時:2019/07/06 10:02
  • 回答No.1

ベストアンサー率 44% (227/515)

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

お礼率 92% (12/13)

oboroxx様

ご回答ありがとうございます。
確認します。
投稿日時:2019/07/06 10:03
結果を報告する
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,600万件のQ&Aを分析して最適な回答をご提案します。

関連するQ&A

その他の関連するQ&Aをキーワードで探す

ピックアップ

ページ先頭へ