Bei Rechtsklick Listbox-Zeile wählen und ShowPopup
09.06.2009 14:46:28
Martin
ich suche eine gute Möglichkeit beim Rechtsklick auf eine Listbox einer UserForm die Listboxzeile auszuwählen, über der sich die Maus befindet und ein Popup-Menü zu zeigen. Eigentlich habe ich das Problem schon gelöst, aber der Lösungsweg gefällt mir nicht, da ich zum Auswählen der Listboxzeile einen linken Mausklick per VBA erzeuge und dadurch das Mausklick-Ereignis neu ausgelöst wird. Daher habe ich das ganze über die mittlere Maustaste provisorisch gelöst: https://www.herber.de/bbs/user/62313.xls
Option Explicit
Dim m_Menu As CommandBar
'Mausklick
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As _
Single, ByVal y As Single)
If Button = 2 Then 'wenn Klick rechte Maustaste
'Klick linke Maustaste
Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
'Klick mittlere Maustaste
Call mouse_event(MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0)
Call mouse_event(MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0)
ElseIf Button = 4 And ListBox1.ListIndex > -1 Then 'wenn Klick mittlere Maustaste
'Kontextmenü anzeigen
m_Menu.ShowPopup 'CommandBars("Cell").ShowPopup
End If
End Sub
Private Sub UserForm_Initialize()
Dim m_MenuItem1 As CommandBarButton
Dim m_MenuItem2 As CommandBarButton
ListBox1.AddItem "Eintrag 1"
ListBox1.AddItem "Eintrag 2"
ListBox1.AddItem "Eintrag 3"
On Error Resume Next
Set m_Menu = CommandBars("TestMenu")
'm_Menu.Delete
'Set m_Menu = Nothing
On Error GoTo 0
If m_Menu Is Nothing Then
Set m_Menu = Application.CommandBars.Add(Name:="TestMenu", Position:=msoBarPopup, _
Temporary:=False)
Set m_MenuItem1 = m_Menu.Controls.Add(msoControlButton)
Set m_MenuItem2 = m_Menu.Controls.Add(msoControlButton)
m_MenuItem1.Caption = "Button 1"
m_MenuItem2.Caption = "Button 2"
m_MenuItem1.OnAction = "Makro1"
m_MenuItem2.OnAction = "Makro2"
End If
End Sub