「VBでExcel上PictureBoxダブルクリックイベントを取得したい」について

質問

「VBでExcel上PictureBoxダブルクリックイベントを取得したい」
http://oshiete1.goo.ne.jp/kotaeru.php3?q=203163
について思ったことがありまして、ここに書かせていただきます。
この質問にはTodo36さんが答えられました。
Chika-Fさんの望む処理と違うようなので、サブクラス化の案をTodo36さんは述べられて、σ(￣ー￣ ボクに託してくださいました。
僕も全く同じ処理を考えていましたのですが、実現不可能でした。
そんな時に出張にいく事になり、結末が気になりながらも、自分なりに考えながら出張にでました。
そこでWith Eventを考えたのですが、エクセルアプリ・ブック・シートなどのイベントは拾えたのですが、シート内に存在するピクチャボックスのエベントは拾う事ができませんでした。
どうしてもエクセルにコードを書かないとできませんでした。

どのようにしたらそのイベントが拾えるのかが極めて知りたいです。
サンプルを載せてくれませんでしょうか？
よろしくお願いします。

回答No.1

Chika-F · ベストアンサー

TAGOSAKU7さん、こんにちは。

サンプルをＵＰします。参考になると良いのですが・・・

私も質問があります。
サンプルREMARK部分でエラーになります。
質問を投稿してありますが良回答を
得られずに困っています。
ご存知でしたら教えて下さい。

【サンプル準備】
標準フォームを１つ作成
同フォームにボタンを２つ作成
TESTという名前でExcelブックを作成
同Excelシートに「Image1」という名前でPictureBox（イメージ）を１つ作成
同ブックをアプリケーションと同フォルダーに保存
参照設定に気を付けて下さい。

【サンプル】
Option Explicit

Private WithEvents XLApp As Excel.Application
Private WithEvents XLBook As Excel.Workbook
Private WithEvents XLSheet As Excel.Worksheet
Private WithEvents XLImage As MSForms.Image
'--------------------------------------------------
'Excel起動
'--------------------------------------------------
Private Sub Command1_Click()

'AppObjectセット
Set XLApp = CreateObject("Excel.Application")
'Excel起動
XLApp.Workbooks.Open FileName:=App.Path & "\TEST.xls"
'WorkBookObjectセット
Set XLBook = XLApp.ActiveWorkbook
'WorkSheetObjectセット
Set XLSheet = XLBook.Sheets(1)
'PictureObjectセット
Set XLImage = XLSheet.OLEObjects("Image1").object
'Excel表示
XLApp.Visible = True
'フォーム非表示（２重起動防止）
Me.Visible = False

End Sub
'--------------------------------------------------
'アプリケーション終了
'--------------------------------------------------
Private Sub Command2_Click()

Unload Me
End

End Sub
'--------------------------------------------------
'ExcelBookクローズ時処理
'--------------------------------------------------
Private Sub XLApp_WorkbookBeforeClose(ByVal Wb As Excel.Workbook, Cancel As Boolean)

'終了時に保存メッセージを表示させない
XLApp.DisplayAlerts = False
'ExcelApp終了
XLApp.Quit
'変数解放
Set XLImage = Nothing
Set XLSheet = Nothing
Set XLBook = Nothing
Set XLApp = Nothing
'フォーム表示
Me.Visible = True

End Sub
'--------------------------------------------------
'ExcelImageダブルクリック時処理
'--------------------------------------------------
Private Sub XLImage_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim OpenRet As Variant
'確認メッセージ
XLApp.Visible = False
MsgBox ("Get PictureBox Event")
XLApp.Visible = True

'-----------------------------------------------------------
'---私も質問したい箇所です。最初はＲＥＭ(')して下さい
'--.Pictureでオートメーションエラーが出ます。
'--解決法がありましたら教えて下さい。
' OpenRet = Application.GetOpenFilename _
' ("BMP,*.BMP,JPEG,*.JPG,GIF,*.GIF", , "画像選択")
' If OpenRet = False Then Exit Sub
' With XLImage
' .AutoLoad = True
' .AutoSize = False
' .PictureSizeMode = fmPictureSizeModeZoom
' .PictureAlignment = fmPictureAlignmentCenter
' .Picture = LoadPicture(OpenRet)
' End With
' SavePicture XLImage.Picture, App.Path & "\TmpPict.JPg"
'-----------------------------------------------------------

End Sub

お礼

>Private WithEvents XLImage As MSForms.Image
なるほど。。。
FM20.DLLの存在は、以前に見つけていたのですが、それの応用の方法をはじめて見ました。
カンシャです。＿(.＿.)＿

・・・で、逆に質問されてしまいましたね。。。(;￣▽￣A　あせあせ

LoadPicture
ですが、命令後はVB6ならば
VB6もEXCELもVB6のタイプライブラリを使用していますが、EXCELのイメージやフォームなどのオブジェクト類は全く別のDLLを元に創成されます。

なのでLoadPictureはVB6で使用した場合、VB6用のピクチャタイプで値を返します。
.Picture = MSForms.LoadPicture(OpenRet)
みたいな事ができればよいのですが・・・残念な事にその行は赤々となり、エラーと表示されてしまいます。
同様にSavePictureですが、パラメータはVB6オブジェクトのイメージをパラメータに渡さなければいけません。

回避方法は・・・わかりません・・・お役に立てずすいません。。。