エクセル 「コメント」の背景に画像を配置する

質問

在庫商品を検索する表を作っています（Excel 2003です）。

検索の条件を入力すると（B4、B6）、D～Fの列に検索結果が表示されます。
この時、F列に呼び出された「商品画像のパス」から画像を見る際、クリックしてブラウザを立ち上げて確認するのではなく、もっと簡単にザーっと見られないかと思っています（実際の表は250行あり、確認する画像が多い時がありますので）。

そこで、セルにマウスを合わせるだけで表示される「コメント」の背景に画像を配置できないかと考えましたが、そのつど変わる検索結果にどうやって対応させたらよいのか分かりません。
――――――――――――――――――――――――――――――
コメントの編集

　→色と線
　　→塗りつぶし（色）
　　　→塗りつぶし効果
　　　　→図
　　　　　→図の選択（※１）
――――――――――――――――――――――――――――――
ここ（※１）の「ファイル名」に式？を設定するなどして、検索結果によって変化する画像を呼び出す方法はあるでしょうか。
もしくは難しいマクロの設定などが必要でしょうか…（マクロは初心者です）。

ご存知の方がいらっしゃいましたら、教えてください。
また、特に「コメント」にこだわってはおりませんので、他の方法やヒントなどを教えていただけたら嬉しいです。

どうぞよろしくお願いいたします。

回答No.6

mitarashi · ベストアンサー

#5のコメントに対してですが、その様な場合は、Vlookupで引っ張ってきた、元のファイル名の方を処理対象にしてください。
例えばVlookupで取得したファイル名のリストがB列にあるとして、C列のハイパーリンク関数の入ったセルにコメントをつけるとしたら、下記の様に出来ます。iの範囲は、適当に大きめに設定して下さい。
Sub setCommentToHyperLinks2()
Dim myRange As Range
Dim i As Long

For i = 2 To 100
Set myRange = ActiveSheet.Range("B" & i)
If UCase(Right(CStr(myRange.Value), 4)) = ".JPG" Then
makeThumbnail myRange.Value, "C:\test.bmp"
With myRange.Offset(0, 1)
.ClearComments
.AddComment
.Comment.Shape.Fill.UserPicture "C:\test.BMP"
End With
End If
Next i
End Sub
その次のコメントについては、どの様な現象かちょっと理解できません。

お礼

mitarashi様

度々申し訳ありません。
教えていただいた通りやったところ、できました！
最初はなかなかうまくいかなくて…。
（もちろんこちらのつまらないミスです）
ファイルを作り直したり色々と試していたのでお礼が遅くなりました。
すみません。
仕事で活用させていただきます。
この度はどうもありがとうございました。

回答No.5

mitarashi

#4の続きです。setCommentToHyperLinksを実行すると、アクティブシートに存在するJPEG画像へのハイパーリンクが入ったセルにコメントを設定し、コメントにその画像のサムネイルを貼り付けます。
Sub setCommentToHyperLinks()
Dim myRange As Range
Dim item As Hyperlink

For Each item In ActiveSheet.UsedRange.Hyperlinks
If UCase(Right(item.Address, 3)) = "JPG" Then
makeThumbnail item.Address, "C:\test.BMP"
Set myRange = item.Parent
With myRange
.ClearComments
.AddComment
.Comment.Shape.Fill.UserPicture "C:\test.BMP"
End With
End If
Next
End Sub

Private Function makeThumbnail(ByVal SrcFileName As String, ByVal DstFileName As String) As Boolean
Dim udtInput As GdiplusStartupInput
Dim EncoderId As Guid
Dim lngToken As Long
Dim pSrcImage As Long
Dim pDstImage As Long
Dim lngStatus As Long

udtInput.GdiplusVersion = 1
If GdiplusStartup(lngToken, udtInput, ByVal 0&) <> 0 Then
Exit Function
End If
lngStatus = GdipLoadImageFromFile(ByVal StrPtr(SrcFileName), pSrcImage)
If lngStatus = 0 Then
lngStatus = GdipGetImageThumbnail(pSrcImage, 160, 120, pDstImage, 0, ByVal 0&)
GdipDisposeImage pSrcImage
End If
If lngStatus <> 0 Then
GdiplusShutdown lngToken
Exit Function
End If

CLSIDFromString ByVal StrPtr(CLSID_BMP), EncoderId
If GdipSaveImageToFile(pDstImage, ByVal StrPtr(DstFileName), EncoderId, ByVal 0&) = 0 Then
makeThumbnail = True
End If
GdipDisposeImage pDstImage
GdiplusShutdown lngToken
End Function

補足

mitarashi様

お礼が遅くなりまして申し訳ありません。
２件もご提案いただき、また簡略化やアレンジまでして下さったとのことで大変恐縮です。どうもありがとうございます。
No.４～５のご回答を早速コピーしてそのまま使わせていただいたところ、みごとにコメントが表示され画像を見ることができました！すばらしいです…。

ですが、テストとして作った表では全く問題なく作動したのですが（通常通り「挿入」→「ハイパーリンク」でリンクを一つずつ挿入）、実際の表ではうまくいきませんでした。

■実際の表
１、【在庫一覧】から条件に合うものが「VLOOKUP関数」で呼び出される
２、このままだと‘テキスト’の状態ですので、隣の列に「HYPERLINK関数」を設定してリンク化しています
　※質問に明記しておりませんでした。申し訳ありません。

相対パスでなく絶対パスを呼び出すようにしてみたり…色々とやってみたのですが解決できませんでした。
もしまだこちらをご覧になっておられましたら、原因を教えていただけますでしょうか。どうぞよろしくお願いいたします。

（お時間がありましたら…）
始めにうまくいっていた「テストの表」ですが、何度か試しているうちに最初にコメントに呼び出した画像しか表示されなくなってしまいました。
もしお気づきの点がありましたらヒントを教えていただたら嬉しいです。

回答No.4

mitarashi

#2です。フランス製クラスは敷居が高かろうと、単独で実行できる様に、shiraさんという方の某掲示板での回答を簡略化&アレンジして、使わせていただきました。簡略化しても2000文字に収まらないので、宣言部と関数部に分けて投稿します。サムネイル機能を用いているので、画質は先のコードより劣ります。
Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, pInput As GdiplusStartupInput, _
pOutput As Any) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (filename As Any, Image As Long) As Long
Private Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal Image As Long, filename As Any, _
clsidEncoder As Guid, encoderParams As Any) As Long
Private Declare Function GdipGetImageThumbnail Lib "gdiplus" (ByVal Image As Long, ByVal thumbWidth As Long, _
ByVal thumbHeight As Long, thumbImage As Long, ByVal callback As Long, callbackData As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (lpsz As Any, pclsid As Guid) As Long
Const CLSID_BMP = "{557CF400-1A04-11D3-9A73-0000F81EF32E}"

回答No.3

mitarashi

※何故か回答がどこかに行ってしまった様で表示されないので、再送信します。ダブってしまったらすみません。
コメントに画像が貼り付けられるんですね。初めて知りました。アクティブシートの全ハイパーリンクに画像入りコメントを設定するコードです。
http://okwave.jp/qa/q5618881.html
の、#3～4あたりで紹介しているGDI+用のクラスを用いて、リサイズしてからコメントに設定しています。（そのままのサイズで貼り付けるととても重いファイルが出来上がると思いますので）
そのままのサイズで良ければ、単に改名して保存してから、コメントに設定すればOKです。
Range.Comment.Shape.Fill.UserPicture　の引数のファイル名は、constもしくは、string*50といった形でぴったりサイズに宣言した文字列変数でないと、エラーになります。（少なくとも当方のXL2000の場合は）
このファイルは読み込んでしまえば、中味が変わっても可なので、使い回ししております。
Sub setCommentToHyperLinks()
Dim myRange As Range
Dim clGdip As clGDIplus
Dim lReturn As Long, blReturn As Boolean
Const destFilePath As String = "C:\test.bmp"
Dim item As Hyperlink

Set clGdip = New clGDIplus
For Each item In ActiveSheet.UsedRange.Hyperlinks
If UCase(Right(item.Address, 3)) = "JPG" Then
clGdip.OpenFile (item.Address)
lReturn = clGdip.Resize(160, 120, True, False)
blReturn = clGdip.SaveFile("C:\test.bmp", "BMP")
Set myRange = item.Parent
myRange.ClearComments
myRange.AddComment
myRange.Comment.Shape.Fill.UserPicture destFilePath
End If
Next
End Sub

回答No.2

mitarashi

コメントに画像が貼り付けられるんですね。初めて知りました。アクティブシートの全ハイパーリンクに画像入りコメントを設定するコードです。
http://okwave.jp/qa/q5618881.html
の、#3～4あたりで紹介しているGDI+用のクラスを用いて、リサイズしてからコメントに設定しています。（そのままのサイズで貼り付けるととても重いファイルが出来上がると思いますので）
そのままのサイズで良ければ、単に改名して保存してから、コメントに設定すればOKです。
Range.Comment.Shape.Fill.UserPicture　の引数のファイル名は、constもしくは、string*50といった形でぴったりサイズに宣言した文字列変数でないと、エラーになります。（少なくとも当方のXL2000の場合は）
このファイルは読み込んでしまえば、中味が変わっても可なので、使い回ししております。
Sub setCommentToHyperLinks()
Dim myRange As Range
Dim clGdip As clGDIplus
Dim lReturn As Long, blReturn As Boolean
Const destFilePath As String = "C:\test.bmp"
Dim item As Hyperlink

Set clGdip = New clGDIplus
For Each item In ActiveSheet.UsedRange.Hyperlinks
If UCase(Right(item.Address, 3)) = "JPG" Then
clGdip.OpenFile (item.Address)
lReturn = clGdip.Resize(160, 120, True, False)
blReturn = clGdip.SaveFile("C:\test.bmp", "BMP")
Set myRange = item.Parent
myRange.ClearComments
myRange.AddComment
myRange.Comment.Shape.Fill.UserPicture destFilePath
End If
Next
End Sub

回答No.1

end-u

[コントロールツールボックス]のイメージを配置する方法があります。

画像を表示させたい場所に Imageコントロールを挿入し、
プロパティの[PictureSizeMode]を fmPictureSizeModeZoom にしてください。
解からない場合は、目的のシートをActiveにして下記 Sub test() を実行。

Sub test()
　　With ActiveSheet.Range("H4").Resize(6, 3)
　　　　.Worksheet.OLEObjects.Add(ClassType:="Forms.Image.1", _
　　　　　　　　　　　　　　　　　Left:=.Left, Top:=.Top, _
　　　　　　　　　　　　　　　　　Width:=.Width, Height:=.Height) _
　　　　　　　　　.Object.PictureSizeMode = 3 'fmPictureSizeModeZoom
　　End With
End Sub

Imageコントロールを挿入したら、そのシートのタブを右クリック[コードの表示]。
シートモジュールが表示されるので以下コピーペースト。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　Dim s As String

　　If Target.Column <> 6 Then Exit Sub
　　If Target.Count > 1 Then Exit Sub

　　s = Target.Value
　　With Me.Image1
　　　　If Len(s) = 0 Then
　　　　　　.Visible = False
　　　　Else
　　　　　　.Visible = True
　　　　　　If Len(Dir(s)) = 0 Then
　　　　　　　　.Picture = LoadPicture("")
　　　　　　Else
　　　　　　　　.Picture = LoadPicture(s)
　　　　　　End If
　　　　End If
　　End With
End Sub

Target.Column = 6 つまりF列 を選択変更するたびに実行されるイベントプロシージャです。
Me.Image1.Picture = LoadPicture(s)
ここで選択したセル文字列のファイルを読み込みます。

お礼

end-u様
いつもお世話になっております。
教えていただいた通りにやってみたところ、できてしまいました。
・・・すごいです。
実際の表に対応させるにはもう少しかかりそうなので、
ちょっとお時間をいただいて完成させたいと思います。
取り急ぎお礼申し上げます。
ありがとうございました！