excel2003を利用しています。
技術的に可能か、どうかわかりませんが、もし可能であれば、
どのように、記述(vba)すればよいか教えていただきたいです。
とあるセルに、写真が保管されているパスが入力されています。
そのセルにマウスカーソルを合わせると、そのアドレスに保管されている
写真がポップアップやコメントマークのような感じで、パッと表示され、
マウスカーソルを、そのセルから、外すと写真の表示が消えるようにしたいです。
もし可能であれば、教えていただけると大変ありがたいです。よろしくお願いします。
A 回答 (6件)
- 最新から表示
- 回答順に表示
No.5
- 回答日時:
#2です。
試した結果、JPEGを貼り付ける方がファイルが小さいため、サムネイルのJPEG保存にトライしてみました。Tempフォルダーに保存しています。Win7Home(64bit)、xl2010(32bit)で動作しました。Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Type EncoderParameter
Guid As Guid
NumberOfValues As Long
Type As Long
Value As Long
End Type
Type EncoderParameters
Count As Long
Parameter(15) As EncoderParameter
End Type
Declare Function GdiplusStartup Lib "gdiplus.dll" _
(ByRef token As Long, ByRef inputBuf As GdiplusStartupInput, ByVal outputBuf As Long) As Long
Declare Sub GdiplusShutdown Lib "gdiplus.dll" (ByVal token As Long)
Declare Function GdipDisposeImage Lib "gdiplus.dll" _
(ByVal image As Long) As Long
Declare Function GdipSaveImageToFile Lib "gdiplus.dll" _
(ByVal image As Long, ByVal filename As Long, ByRef clsidEncoder As Guid, ByVal encoderParams As Long) As Long
Declare Function CLSIDFromString Lib "ole32" _
(ByVal lpszCLSID As Long, ByRef pclsid As Guid) As Long
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
Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As Long, image As Long) As Long
Declare Function GdipGetImageHeight Lib "gdiplus" _
(ByVal image As Long, Height As Long) As Long
Declare Function GdipGetImageWidth Lib "gdiplus" _
(ByVal image As Long, Width As Long) As Long
Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Const MAX_PATH As Integer = 260
Const CLSID_JPEG = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
Const CLSID_QUALITY = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
Sub test()
Dim ret As Boolean
ret = SaveThumbnail("E:\hoge.jpg", getTempFolder & "temp.jpg")
End Sub
Function SaveThumbnail(srcFilename As String, dstfilename As String) As Boolean
Dim GdiPStartupInput As GdiplusStartupInput
Dim ret As Long
Dim GDIPToken As Long
Dim EncodParameters As EncoderParameters
Dim pSrcImage As Long
Dim pDstImage As Long
Dim picWidth As Long, picHeight As Long
Const Quality = 85
On Error GoTo errHandle
GdiPStartupInput.GdiplusVersion = 1
If GdiplusStartup(GDIPToken, GdiPStartupInput, 0&) <> 0 Then Exit Function
ret = GdipLoadImageFromFile(ByVal StrPtr(srcFilename), pSrcImage)
If ret <> 0 Then GoTo errHandle
ret = GdipGetImageWidth(pSrcImage, picWidth)
ret = GdipGetImageHeight(pSrcImage, picHeight)
If picHeight > picWidth Then
ret = GdipGetImageThumbnail(pSrcImage, 120, 160, pDstImage, 0, ByVal 0&)
Else
ret = GdipGetImageThumbnail(pSrcImage, 160, 120, pDstImage, 0, ByVal 0&)
End If
If ret <> 0 Then GoTo errHandle
GdipDisposeImage pSrcImage
If ret = 0 Then
EncodParameters.Count = 1
With EncodParameters.Parameter(0)
.Guid = ConvCLSID(CLSID_QUALITY)
.NumberOfValues = 1
.Type = 4
.Value = VarPtr(Quality)
End With
ret = GdipSaveImageToFile(pDstImage, StrPtr(dstfilename), ConvCLSID(CLSID_JPEG), VarPtr(EncodParameters))
If ret <> 0 Then
GoTo errHandle
Else
SaveThumbnail = True
End If
GdipDisposeImage pDstImage
End If
errHandle:
GdiplusShutdown GDIPToken
End Function
Function ConvCLSID(ByVal sGuid As String) As Guid
CLSIDFromString StrPtr(sGuid), ConvCLSID
End Function
Function getTempFolder() As String
Dim FolderName As String
FolderName = Space(MAX_PATH)
GetTempPath Len(FolderName), FolderName
getTempFolder = Left(FolderName, InStr(1, FolderName, vbNullChar) - 1)
End Function
No.4
- 回答日時:
No3です。
先のコードだといちいち×でフォームを消さないといけないので面倒ですので以下のようにすると
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Value <> "" Then
If Dir(Target.Value) <> "" Then
UserForm1.Image1.Picture = LoadPicture(Target.Value)
UserForm1.Show (vbModeless)
ElseIf UserForm1.Visible = True Then
Unload UserForm1
End If
ElseIf UserForm1.Visible = True Then
Unload UserForm1
End If
End Sub
他のセルを選択したときにパスでなければフォームが消えますし、パスならその画像が引き続き表示されます。
No.3
- 回答日時:
No1です。
とりあえず、ご希望の動作とは違いますが、「セルをクリックして選択するセルを変更したとかだとそのアクションによって何かをさせることはできます」と書いたので一応の例です。
UserFormを作成してそこにコントロールのイメージを配置し、該当のシートのシートモジュールに以下のコードを
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Value <> "" Then
If Dir(Target.Value) <> "" Then
UserForm1.Image1.Picture = LoadPicture(Target.Value)
UserForm1.Show
End If
End If
End Sub
パスが入力されたセルを他のセルからクリックし直すとと画像の表示されたフォームが開きます。
フォームや画像の大きさを元の画像と合わせたい場合は、適宜それぞれプロパティで高さや幅をコードの中で指定してやることになります。
No.2
- 回答日時:
セルのコメントに画像を貼り付ける方法を回答した事があります。
http://oshiete.goo.ne.jp/qa/5640681.html
コメントに画像をロードするコードについて、xl2000時代の知見ですが、
>Range.Comment.Shape.Fill.UserPicture の引数のファイル名は、
>constもしくは、string*50といった形でぴったりサイズに宣言した
>文字列変数でないと、エラーになります。
>このファイルは読み込んでしまえば、中味が変わっても可なので、使い回ししております。
ご参考まで。
No.1
- 回答日時:
エクセルはマウスの位置を常時監視するという機能がありませんから、セルにマウスを「合わせる」とどうにかするという事が出来ません。
セルをクリックして選択するセルを変更したとかだとそのアクションによって何かをさせることはできまので、それで画像を表示させて、他のセルをクリックしたら消すとうことはできるでしょう。
ただ、それだとハイパーリンクを利用して画像を画像ソフトで表示するようにしても機能としては大差がないと思われます。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excelのマクロについてご教授ください 2 2023/02/25 09:43
- 会計ソフト・業務用ソフト Excelマクロに詳しい方教えてください 1 2023/06/29 16:18
- Visual Basic(VBA) 【VBA】データを入力後に,同一シート内に履歴として転記するVBAコードを教えていただきたいです。 3 2022/11/16 01:37
- その他(データベース) Accessフォームからパラメーターで表示したレコードを指定のExcelのセルへ転送する方法について 2 2022/08/22 18:04
- Visual Basic(VBA) EXCEL VBA データベースの内容をユーザーフォームに表示したい。 5 2023/02/14 11:40
- Visual Basic(VBA) エクセルVBAについて 2 2023/01/31 16:21
- Excel(エクセル) エクセルVBA 任意のセルの選択時、指定のセルの値を表示 1 2023/04/21 08:13
- Excel(エクセル) エクセル バーコード作成で他のシートを参照するには? 2 2023/05/03 16:57
- Excel(エクセル) Excel VBAについてです。 少しだけ知識はあるのですが、 うまくいかなかったので 質問させてい 3 2022/09/13 18:40
- Visual Basic(VBA) 【VBA】写真の縦横比を変えずに貼り付ける 5 2023/06/13 11:42
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【エクセル】IF関数 Aまたは...
-
エクセルで指定したセルのどれ...
-
対象セル内(複数)が埋まった...
-
貼り付けで複数セルに貼り付けたい
-
エクセル 足して割る
-
Excelで数式内の文字色を一部だ...
-
セルをクリック⇒そのセルに入力...
-
エクセルのセルの枠を超えて文...
-
エクセル オートフィルタで絞...
-
Excelでのコメント表示位置
-
excelのCOUNTIF関数で、『範囲=...
-
エクセルの一つのセルに複数の...
-
(Excel)数字記入セルの数値の後...
-
【Excel】 セルの色での判断は...
-
エクセルで第2、第4土曜日を抽...
-
EXCELで優先順位をつけて表示
-
枠に収まらない文字を非表示に...
-
エクセルvba (ByVal Targ...
-
EXCEL VBA セルに既に入...
-
エクセル 数字の前の「00」を...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで指定したセルのどれ...
-
【エクセル】IF関数 Aまたは...
-
対象セル内(複数)が埋まった...
-
エクセル 足して割る
-
Excelで数式内の文字色を一部だ...
-
貼り付けで複数セルに貼り付けたい
-
Excelでのコメント表示位置
-
セルをクリック⇒そのセルに入力...
-
EXCEL VBA セルに既に入...
-
excelのCOUNTIF関数で、『範囲=...
-
【Excel】 セルの色での判断は...
-
エクセル オートフィルタで絞...
-
エクセルのセルの枠を超えて文...
-
(Excel)数字記入セルの数値の後...
-
Excelで、「特定のセル」に入力...
-
エクセルの一つのセルに複数の...
-
複数のセルのいずれかに数字が...
-
excelの特定のセルの隣のセル指...
-
数式を残したまま、別のセルに...
-
ハイパーリンクの参照セルのズ...
おすすめ情報