[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『コンボボックスをマウスホイールで上下させたい』(たまやん)
こんにちは。 VBAの件で質問お願い致します。
コンボボックスのデータを見るときにマウスホイールで移動させるには どのような設定、またはコードを書けばいいのでしょうか?
< 使用 Excel:Excel2010、使用 OS:Windows7 >
標準機能では出来ないので、外部機能を利用することになるかと思います。
下記は Access の記事ですが、基本的には同じ考え方になるでしょうか。 http://www.f3.dion.ne.jp/~element/msaccess/AcTipsFrmMouseWheelEvent.html
下記の「VBA、VB6 で、マウスホイールによるスクロールを可能にする方法、ソフト」 あたりも見てみてください。 https://ittechinf.wiki.zoho.com/VBA.html (Mook) 2014/10/22(水) 11:09
Mookさん
ありがとうございますm(__)m なかなか難しそうですが、チャレンジしてみます。 (たまやん) 2014/10/22(水) 11:15
横から失礼します。
コンボボックスのデータを見ることが目的でしたら、 クリックイベントで新しいフォームを立ち上げて、リストボックスコントロールに表示させる などはいかがでしょう?
マウスホイールの読んでみたけど、私には出来そうにないなぁ・・・。 (稲葉) 2014/10/22(水) 12:53
以前、Access でやってみたことがありましたが、1日がかりでした。 結構コードも書いた気がするので、ある程度 VB やイベントの理解がないと 大変かもしれません。
稲葉さんだったら、やる気になれば出来ると思いますけれど。 (Mook) 2014/10/22(水) 13:01
有り難いお言葉ですが、買いかぶりすぎです! 精々提供されたDLLに繋いでイベントを拾ったとしても、 コンボボックスをクリックしたときに出てくるスクロールバーがついた一覧のコントロールに プロパティがあるのかすら調べられませんでした・・・
なのでやっぱり簡単な方法があるならそちらを選んでしまいますねぇ・・・。
(稲葉) 2014/10/22(水) 14:32
色々調べてみて、それらしいことは出来ましたので、参考までに・・・ 4. マウスの低レベルフック(グローバルフック) http://veaba.keemoosoft.com/2013/11/728/ こちらのコードをそのまま使用させていただきました。
1)ユーザーフォームを作成し、名前をUserForm1にします。 2)ユーザーフォームにコンボボックスを作成し、名前をComboBox1にします。 3)クラスモジュールを作成し、名前をMouseEventHookとします。 4)標準モジュールを作成し、名前は作られたときのままでOKです。 5)ユーザーフォームに以下のコードを貼り付けてください。 Option Explicit Public M_Over As String Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) M_Over = "CB1" End Sub Private Sub UserForm_Initialize() ComboBox1.RowSource = "A1:A100" Call MouseEventHook.Start End Sub Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) M_Over = "" End Sub Private Sub UserForm_Terminate() MouseEventHook.Terminate End Sub
6)クラスモジュールに以下のコードを貼り付けてください Option Explicit
Private Declare Function SetWindowsHookEx Lib _ "User32.dll" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, _ ByVal hMod As Long, ByVal dwThreadId As Long) As Long Private Const WH_MOUSE_LL As Long = 14
Private Declare Function UnhookWindowsHookEx Lib _ "User32.dll" (ByVal hhk As Long) As Long
Private Declare Function CallNextHookEx Lib _ "User32.dll" (ByVal hhk As Long, ByVal nCode As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib _ "User32.dll" Alias "GetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Const GWL_HINSTANCE As Long = -6
Private Declare Sub CopyMemory Lib _ "kernel32" Alias "RtlMoveMemory" _ (Destination As Any, Source As Any, ByVal Length As Long)
Private Type Point X As Long Y As Long End Type Private Type MouseLLHookStruct Point As Point mouseData As Long flags As Long time As Long dwExtraInfo As Long End Type
Private pv_IsRunning As Boolean Private pv_WindowHandle As Long Private pv_MouseHookHandle As Long
Public Sub Start() If pv_IsRunning = False Then pv_WindowHandle = Application.hWnd pv_MouseHookHandle = SetWindowsHookEx(WH_MOUSE_LL, _ AddressOf MouseEventHookHandler, _ GetWindowLong(pv_WindowHandle, GWL_HINSTANCE), 0) If pv_MouseHookHandle = 0 Then Debug.Print ("マウスメッセージフックのインストールが失敗しました。") Else Debug.Print ("マウスメッセージフックのインストールが成功しました。") pv_IsRunning = True End If End If End Sub
Public Function MouseLLHookProc(ByVal nCode As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Dim m_Return As Long Dim m_MouseLLHookStruct As MouseLLHookStruct
On Error GoTo ErrorHandler Select Case wParam ' Case 512 '[MouseMove] ' CopyMemory m_MouseLLHookStruct.Point.X, ByVal lParam, LenB(m_MouseLLHookStruct) ' With m_MouseLLHookStruct ' Debug.Print "MouseMove(x=" & .Point.X & ",y=" & .Point.Y & ")" ' End With ' Case 513: Debug.Print "LeftDown" ' Case 514: Debug.Print "LeftUp" ' Case 516: Debug.Print "RightDown" ' Case 517: Debug.Print "RightUp" ' Case 519: Debug.Print "MidDown" ' Case 520: Debug.Print "MidUp" Case 522: '[MouseWheel] CopyMemory m_MouseLLHookStruct.Point.X, ByVal lParam, LenB(m_MouseLLHookStruct) With m_MouseLLHookStruct Select Case .mouseData Case Is > 0: SendKeys "{UP}", True Case Is < 0: SendKeys "{DOWN}", True End Select 'Debug.Print "MouseWheel(" & .mouseData & ")" End With End Select
ErrorHandler:
m_Return = CallNextHookEx(pv_MouseHookHandle, nCode, wParam, lParam)
MouseLLHookProc = m_Return End Function
Public Sub Terminate() If pv_IsRunning Then Call UnhookWindowsHookEx(pv_MouseHookHandle) Debug.Print ("マウスメッセージフックのアンインストールが完了しました。") pv_IsRunning = False End If End Sub
7)標準モジュールに以下のコードを貼り付けてください。 Option Explicit Public MouseEventHook As New MouseEventHook Public Function MouseEventHookHandler(ByVal uMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long On Error GoTo ErrorHandler If UserForm1.M_Over = "CB1" Then Call MouseEventHook.MouseLLHookProc(uMsg, wParam, lParam) End If ErrorHandler: End Function
結局SendKeysに逃げています・・・ コンボボックスのスクロールはどうすればいいんですか・・・ マウスオーバーもなく、マウスムーブだし、VBAだけだと難しいんですねぇ。 (稲葉) 2014/10/22(水) 15:59
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.