Excel関数みたいに画像を抽出するには

質問

とある化学物質を別容器保管する時に使用するラベルを作成しようとしています。
Excelで製品のマスターデータに格納(セルサイズに合わせて配置した画像)を別シートで抽出関数(VLOOKUPやINDEX関数など)で値を抽出するように、格納した画像を抽出してセルサイズに合わせて配置する方法はないでしょうか。
画像以外の値はINDEX関数とMATCH関数を組み合わせて抽出しています。
ネットの文献で数式を使って画像を表示させる方法を参考にしたところ、名前の定義がうまくできませんでした。
〇ttps://k-ohmori9616.hatenablog.com/entry/2019/05/13/153347

Sheet構成は添付画像の通りです。
関数またはVBAで画像を抽出する方法はないでしょうか。
詳しい方いましたらご教授ください。

バージョンはExcel2016 です。

回答No.2

heisukewada · ベストアンサー

GHSラベル要素の手順として

手順として、
1）Sheet1!C5 に　Sheet2!M12　の値を抽出する式を作成します。
=INDEX(Sheet2!$M$11:$M$13,MATCH(Sheet1!$A$3,Sheet2!$I$11:$I$13,0))
この数式を、ドラッグして　Ctrl+C で、クリップボードにコピーしておきます。
２）「数式」タブの”名前の定義”をクリックして（新しい名前）の、窓を開きます。
３）名前を”GHS”とでもしておきます。
４）参照範囲(R)の入力欄をクリックして　Ctrl+Vで、先程の式を入力します。
５）「OK」ボタンをクリックして、窓を閉じます。

６）Sheet1!C5　を、クリックしてアクティブにします。
７）Sheet2!M12にある、画像を　右クリック（２回）　して、ポップメニューを表示させ、”コピー”を、クリックします。
８）Sheet1!C5に戻り　右クリックして　ポップメニューから　貼り付けの一番左「貼り付け先のテーマを使用」のアイコンをクリックします。
9）画像が選択されている状態で　数式バーに　=GHS と入力してEnterキーを押します。

=INDEX(Sheet2!$M$11:$M$13,MATCH(Sheet1!$A$3,Sheet2!$I$11:$I$13,0))
の　Sheet2!$M$11:$M$13　と　Sheet2!$I$11:$I$13　は、データベースに合わせて終端行の数値を増やしてください。

INDEX,MATCH の数式があっているか確認するためにSheet2!M12に数値形データを入れておけば、確認しやすいかと思います。

補足

回答ありがとうございます。
試したところ、関数で抽出することができました。

抽出はできるのですが、セル枠ごと表示されてしまうのですが、画像をだけにする方法など可能でしょうか。
枠線もそのままスクショしたみたいに貼り付けされるので、Sheet２は枠線を非表示にしていますがSheet１のセルの枠からはみ出てしまいます。

ご教授頂けたら幸いです。

回答No.6

heisukewada

申し訳ないです、再度手直ししました。
画像を貼り付けると、前に画像があった場合その上に2重に貼り付けてしまうので、Sheet1のすべての画像を削除してから、貼り付けるようにしました。
「危険有害性情報」は、文字列にして、画像ではないようにしました。なので、セルを結合しておいたほうがいいです。

Sub 貼り付ける()

Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim lastRowSource As Long
Dim idToFind As String
Dim foundCell As Range
Dim imgDest As Range
Dim shp As Shape

' Sheet1をソースシートとして設定
Set wsSource = ThisWorkbook.Sheets("Sheet1")
' Sheet2をデータが格納されているシートとして設定
Set wsDest = ThisWorkbook.Sheets("Sheet2")

' Sheet1のA3セルに入力されたIDを取得
idToFind = wsSource.Range("A3").Value

' Sheet2のI列でIDを検索
lastRowSource = wsDest.Cells(wsDest.Rows.count, "I").End(xlUp).Row
Set foundCell = wsDest.Range("I1:I" & lastRowSource).Find(What:=idToFind, LookIn:=xlValues, LookAt:=xlWhole)

' IDが見つかった場合
If Not foundCell Is Nothing Then
' Sheet1に値を貼り付け
wsSource.Range("B3").Value = wsDest.Cells(foundCell.Row, "J").Value ' ID2
wsSource.Range("C3").Value = wsDest.Cells(foundCell.Row, "K").Value ' 製品名
wsSource.Range("A5").Value = wsDest.Cells(foundCell.Row, "L").Value ' 注意喚起語
wsSource.Range("A7").Value = wsDest.Cells(foundCell.Row, "N").Value ' 危険有害性情報
wsSource.Range("D7").Value = wsDest.Cells(foundCell.Row, "O").Value ' 組成及び成分情報
wsSource.Range("C8").Value = wsDest.Cells(foundCell.Row, "P").Value ' SDS改訂日

' 画像を貼り付ける前に、シート上の全ての図形を削除
For Each shp In wsSource.Shapes
shp.Delete
Next shp

' 画像を貼り付け
wsDest.Cells(foundCell.Row, "M").Copy
wsSource.Range("C5").Select
wsSource.Paste

MsgBox "情報を貼り付けました。", vbInformation
Else
' IDが見つからなかった場合
MsgBox "指定されたIDが見つかりませんでした。", vbExclamation
End If

End Sub

回答No.5

heisukewada

手直ししてみました。試してみてください。
Sub 貼り付ける()

Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim lastRowSource As Long
Dim idToFind As String
Dim foundCell As Range
Dim imgDest As Range

' Sheet1をソースシートとして設定
Set wsSource = ThisWorkbook.Sheets("Sheet1")
' Sheet2をデータが格納されているシートとして設定
Set wsDest = ThisWorkbook.Sheets("Sheet2")

' Sheet1のA3セルに入力されたIDを取得
idToFind = wsSource.Range("A3").Value

' Sheet2のI列でIDを検索
lastRowSource = wsDest.Cells(wsDest.Rows.count, "I").End(xlUp).Row
Set foundCell = wsDest.Range("I1:I" & lastRowSource).Find(What:=idToFind, LookIn:=xlValues, LookAt:=xlWhole)

' IDが見つかった場合
If Not foundCell Is Nothing Then
' Sheet1に値を貼り付け
wsSource.Range("B3").Value = wsDest.Cells(foundCell.Row, "J").Value ' ID2
wsSource.Range("C3").Value = wsDest.Cells(foundCell.Row, "K").Value ' 製品名
wsSource.Range("A5").Value = wsDest.Cells(foundCell.Row, "L").Value ' 注意喚起語
wsSource.Range("A7").Value = wsDest.Cells(foundCell.Row, "N").Value ' 危険有害性情報
wsSource.Range("D7").Value = wsDest.Cells(foundCell.Row, "O").Value ' 組成及び成分情報
wsSource.Range("C8").Value = wsDest.Cells(foundCell.Row, "P").Value ' SDS改訂日

' 画像を貼り付け
wsDest.Cells(foundCell.Row, "M").Copy
wsSource.Range("C5").Select
ActiveSheet.Paste

MsgBox "情報を貼り付けました。", vbInformation
Else
' IDが見つからなかった場合
MsgBox "指定されたIDが見つかりませんでした。", vbExclamation
End If

End Sub

回答No.4

heisukewada

申し訳ありませんが、セルの処理になるため、VBAをつかっても、画像のみを貼り付けることができません。アドインのxlwingsを使ってPythonで処理をすれば可能かとも思いますが、そこまで作成できませんでした。

方法として、Sheet2のGHSの、セルと　Sheet1C5のセルを同じ大きさにして貼り付けたらと思います。
その際、「危険有害性情報」は、画像ではなく文字列で記入すれば、行の高さに影響が出ないかと思います。また、Sheet1に転機した際も、フォントサイズを調整できるので、そのほうが良いかと思います。
とりあえず、VBAを乗せておきます。C5:F5を結合すると貼付けできないでエラーが起きます。A7:C7についても同様です。

Sub 貼り付ける()

Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim lastRowSource As Long
Dim idToFind As String
Dim foundCell As Range
Dim imgDest As Range

' Sheet1をソースシートとして設定
Set wsSource = ThisWorkbook.Sheets("Sheet1")
' Sheet2をデータが格納されているシートとして設定
Set wsDest = ThisWorkbook.Sheets("Sheet2")

' Sheet1のA3セルに入力されたIDを取得
idToFind = wsSource.Range("A3").Value

' Sheet2のI列でIDを検索
lastRowSource = wsDest.Cells(wsDest.Rows.count, "I").End(xlUp).Row
Set foundCell = wsDest.Range("I1:I" & lastRowSource).Find(What:=idToFind, LookIn:=xlValues, LookAt:=xlWhole)

' IDが見つかった場合
If Not foundCell Is Nothing Then
' Sheet1に値を貼り付け
wsSource.Range("B3").Value = wsDest.Cells(foundCell.Row, "J").Value ' ID2
wsSource.Range("C3").Value = wsDest.Cells(foundCell.Row, "K").Value ' 製品名
wsSource.Range("A5").Value = wsDest.Cells(foundCell.Row, "L").Value ' 注意喚起語
wsSource.Range("D7").Value = wsDest.Cells(foundCell.Row, "O").Value ' 組成及び成分情報
wsSource.Range("C8").Value = wsDest.Cells(foundCell.Row, "P").Value ' SDS改訂日

' 画像を貼り付け
Set imgDest = wsSource.Range("C5")
wsDest.Cells(foundCell.Row, "M").CopyPicture Appearance:=xlScreen, Format:=xlPicture
imgDest.PasteSpecial
Set imgDest = wsSource.Range("A7")
wsDest.Cells(foundCell.Row, "N").CopyPicture Appearance:=xlScreen, Format:=xlPicture
imgDest.PasteSpecial

MsgBox "情報を貼り付けました。", vbInformation
Else
' IDが見つからなかった場合
MsgBox "指定されたIDが見つかりませんでした。", vbExclamation
End If

End Sub

回答No.3

SI299792

Sheet2の枠線を消せば、画像に枠線はつきません。

作って見ました。
セル位置は画像の通りとしました。
https://1drv.ms/x/s!AnfEM367OeSdmFWEa3a3wD9VX0j-?e=nUvGgA
（ダウンロードをしないと機能しません）
名前の定義は、Ｘ列以右を参考にして下さい。

回答No.1

luka3

・画像をVLOOKUP関数のように表示させるテクニック
https://www.forguncy.com/blog/20170818_vlookup_picture

自分が知ってる画像差し替え方法はこれです。