Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1224to1228
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Onkey für Mausklick

Onkey für Mausklick
Hartmut_M
Hallo,
gibt es eigentlich eine Möglichkeit den Mausklick mit Onkey abzufragen?
Ähnlich wie die Enter Taste: Application.OnKey "{ENTER}"
Danke für die Unterstützung.
Hartmut

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Onkey für Mausklick
04.08.2011 17:03:40
Josef

Hallo Hartmut,
nicht das mir bekannt wäre, was willst du den erreichen?

« Gruß Sepp »

AW: Onkey für Mausklick
04.08.2011 17:09:09
Hartmut_M
Hallo Sepp, ich will aus der aktiven Zelle ein Makro ausführen.
Durch betätigen der Tasten "Enter" und "Tab" ist das möglich mit unten aufgeführtem Code.
Nun hätt ich gerne, dass das ganze auch beim Klicken mit der Maus funktioneirt.
Gibt es eine Chance das umzusetzen?
Private Sub Worksheet_Activate()
'ENTER und TAB-Taste als Sprungtaste einrichten
'Wenn der Namen des aktiven Blattes "" ist, dann...
If ActiveSheet.Name = "Eingabe" Then
'Bei Betätigen der Entertaste auf der Tastatur, das
'Makro "Nächste_Zelle" ausführen...
Application.OnKey "{ENTER}", "Combo2"
Application.OnKey "{TAB}", "Combo2"
'Bei Betätigen der Entertaste auf der Zehnertastatur, das
'Makro "Nächste_Zelle" ausführen...
Application.OnKey "~", "Combo2"
Application.OnKey "{TAB}", "Combo2"
'ansonsten...
Else
'Mit der Entertaste auf der Tastatur die normale Funktion ausführen
Application.OnKey "{ENTER}"
Application.OnKey "{TAB}"
'...mit der Entertaste auf der Zehnertastatur die normale
'Funktion ausführen...
Application.OnKey "~"
End If
Anzeige
AW: Onkey für Mausklick
04.08.2011 17:25:11
Josef

Hallo Hartmut,
vom Prinzip her geht das so, aber ob das Praktikabel ist, bezweifle ich.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Const VK_LBUTTON = &H1
Private Const VK_RBUTTON = &H2

Private WithEvents Timer1 As APITimer

Private Sub Timer1_Tick()
  If ActiveSheet.Name = "Eingabe" Then
    If GetAsyncKeyState(VK_LBUTTON) Then
      MsgBox "Linke Maustaste in 'Eingabe' gedrückt!"
    ElseIf GetAsyncKeyState(VK_RBUTTON) Then
      MsgBox "Rechte Maustaste in 'Eingabe' gedrückt!"
    End If
  End If
End Sub


Private Sub Workbook_Activate()
  Set Timer1 = New APITimer
  Timer1.IntervalMS = 100
  Timer1.Enabled = True
End Sub


Private Sub Workbook_Deactivate()
  On Error Resume Next
  Timer1.Enabled = False
End Sub


' **********************************************************************
' Modul: APITimer Typ: Klassenmodul
' **********************************************************************

'Code der Klasse "APITimer"

Option Explicit


' benötigte API-Deklarationen
Private Declare Function SetTimer Lib "user32" ( _
  ByVal hWnd As Long, _
  ByVal nIdEvent As Long, _
  ByVal uElapse As Long, _
  ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" ( _
  ByVal hWnd As Long, _
  ByVal uIDEvent As Long) As Long

Private Declare Sub CopyMem Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  pDst As Any, _
  pSrc As Any, _
  ByVal cb As Long)

Private Declare Function VirtualAlloc Lib "kernel32" ( _
  lpAddress As Any, _
  ByVal dwSize As Long, _
  ByVal flAllocationType As Long, _
  ByVal flProtect As Long) As Long

Private Const MEM_COMMIT As Long = &H1000&

Private Declare Function VirtualFree Lib "kernel32" ( _
  lpAddress As Any, _
  ByVal dwSize As Long, _
  ByVal dwFreeType As Long) As Long

Private Const MEM_DECOMMIT As Long = &H4000&

Private Const PAGE_EXECUTE As Long = &H10&
Private Const PAGE_EXECUTE_READ As Long = &H20&
Private Const PAGE_EXECUTE_READWRITE As Long = &H40&

Private Const ASM_SIZE As Long = &HFF&

Private m_ptrCallback As Long
Private m_hdlTimer As Long
Private m_blnEnabled As Boolean
Private m_lngInterval As Long

Public Event Tick()

' muss erste öffentliche Methode in Interface sein!
' API Timer wird diese Methode aufrufen
Public Sub TimerCallback( _
    ByVal hWnd As Long, ByVal uMsg As Long, _
    ByVal idEvent As Long, ByVal dwTime As Long)

  
  RaiseEvent Tick
End Sub


' Aktiviert/Deaktiviert Timer (vgl. VB Intrinsic)
Public Property Get Enabled() As Boolean
  Enabled = m_blnEnabled
End Property


Public Property Let Enabled(ByVal blnValue As Boolean)
  If blnValue <> m_blnEnabled Then
    If blnValue Then
      m_hdlTimer = SetTimer(0, 0, IntervalMS, m_ptrCallback)
    Else
      KillTimer 0, m_hdlTimer
    End If
    m_blnEnabled = blnValue
  End If
End Property


' Bestimmt Interval, in dem Tick Event gefeuert wird
' (in Millisekunden)
Public Property Get IntervalMS() As Long
  IntervalMS = m_lngInterval
End Property


Public Property Let IntervalMS(ByVal lngMs As Long)
  m_lngInterval = lngMs
  
  If Enabled Then
    ' wird Interval geändert während Timer aktiv ist,
    ' muss er neu initialisiert werden
    Enabled = False
    Enabled = True
  End If
End Property


' Adresse erster öffentlicher Methode eines COM Interfaces ermitteln
Private Function GetFirstPublicMethod(ByVal obj As Object) As Long
  Dim pObj As Long
  Dim pVtbl As Long
  
  ' Adresse über VTable des Interfaces (IUnknown und IDispatch
  ' dort zuerst eingetragen, daher 7 Einträge = &H1C Bytes überspringen)
  CopyMem pObj, ByVal ObjPtr(obj), 4
  CopyMem pVtbl, ByVal pObj + &H1C, 4
  
  GetFirstPublicMethod = pVtbl
End Function


' Für ASM Callback genutzten Speicher freigeben
Private Sub FreeCallback(ByVal ptr As Long)
  VirtualFree ByVal ptr, ASM_SIZE, MEM_DECOMMIT
End Sub


' ASM Callback erstellen, das Timercallbacks an eine
' Methode der Klasse weiterleitet
Private Function CreateCallback(ByVal obj As Object, _
    ByVal addr As Long, ByVal params As Long) As Long

  
  Dim ptrMem As Long
  Dim ptrItr As Long
  Dim ptrNewAddr As Long
  Dim i As Long
  Dim j As Long
  
  ' ausführbaren Speicher vom System holen
  ' und Maschinencode reinschreiben
  ptrMem = VirtualAlloc(ByVal 0&, ASM_SIZE, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
  If ptrMem = 0 Then
    Err.Raise 12345, , "VirtualAlloc fehlgeschlagen!"
  End If
  
  ptrItr = ptrMem
  
  For i = 1 To params
    CopyMem ByVal ptrItr + 0, &H2474FF, 3 ' PUSH [ESP+imm8]
    CopyMem ByVal ptrItr + 3, params * 4, 1
    ptrItr = ptrItr + 4
  Next
  
  CopyMem ByVal ptrItr + 0, &H68, 1 ' PUSH imm32
  CopyMem ByVal ptrItr + 1, ObjPtr(obj), 4
  ptrItr = ptrItr + 5
  
  ptrNewAddr = addr - ptrItr - 5
  
  CopyMem ByVal ptrItr + 0, &HE8, 1 ' CALL rel32
  CopyMem ByVal ptrItr + 1, ptrNewAddr, 4
  ptrItr = ptrItr + 5
  
  CopyMem ByVal ptrItr + 0, &HC2, 1 ' RET imm16
  CopyMem ByVal ptrItr + 1, params * 4, 2
  
  CreateCallback = ptrMem
End Function


Private Sub Class_Initialize()
  m_ptrCallback = CreateCallback(Me, GetFirstPublicMethod(Me), 4)
End Sub


Private Sub Class_Terminate()
  If Enabled Then Enabled = False
  FreeCallback m_ptrCallback
End Sub



« Gruß Sepp »

Anzeige
AW: Onkey für Mausklick
04.08.2011 17:36:08
Hartmut_M
Vielen Dank Sepp. Werde den Code in Ruhe analysieren und testen.
Für mein aktuelles Problem gehe ich einen Umweg.
Mein Ziel war, aus einer aktiven Zelle mit Mausklick auf eine Combobox, diese zu öffnen.
Ich wähle jetzt den Weg, dass einfach nicht die Combobox angeklickt wird, sondern eine beliebige andere Zelle. Wünsche dir noch einen schönen sonnigen Abend.
Hartmut
Private Sub Worksheet_Change(ByVal Target As Range)
'HM 04.08.2011
If Target.Address = "$E$5" Then
Sheets("Eingabe").ComboBox2.Activate
Sheets("Eingabe").ComboBox2.DropDown
End If
End Sub

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige