Application.Onkey metodu

[Korhan Ayhan]

Selamlar,

Arkadaşlar belki basit ama Application.Onkey metodu ile bir hücreye rakamları nasıl yazdırırız.

 

[Ali]

Sn COST_CONTROL

Application.Onkey(Key,Prosedür) yöntemi ile tuşa atama için basit bir örnek yaptım
Prosedür sizin çağrılacak yordamınız.

Sub deneme()
Range("A1:A10") = "Ahmet"
End Sub

Sub yordam()
Application.OnKey "%c", "deneme"
End Sub


Alt+C tuşlarına Ahmet kelimesi atanır

 

[Korhan Ayhan]

Selamlar,

Sn. fructose aslında yapmak istediğim bir makro çalıştığında numaratör kısmındaki rakamlardan herhangibirine basıldığını kontrol etmek istiyorum.

Örneğin;

Sub Kontrol()
Application.OnKey "1" ' Burada 1 rakamına basıldığını kontrol etmek istiyorum.
End Sub

 

[byexcel]

Sanırım hangi tuşa basıldığını kontrol etmek istiyorsunuz.
size bir api ekliyorum
status barda döngü çalışırken herhangi bir tuşa basın. Hangi tuşa basıldığını size mesajla verecektir.
[vb/]
Option Base 1
Option Explicit

Type POINTAPI16
x As Integer
y As Integer
End Type

Type MSG16
hWnd As Integer
message As Integer
wParam As Integer
lParam As Long
time As Long
pt As POINTAPI16
End Type

Declare Function FindWindow16 Lib "User" Alias "FindWindow" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Integer

Declare Function PeekMessage16 Lib "User" Alias "PeekMessage" (lpMsg As MSG16, _
ByVal hWnd As Integer, ByVal wMsgFilterMin As Integer, ByVal wMsgFilterMax As Integer, _
ByVal wRemoveMsg As Integer) As Integer

Declare Function TranslateMessage16 Lib "User" Alias "TranslateMessage" (lpMsg As MSG16) As Integer

Type POINTAPI32
x As Long
y As Long
End Type

Type MSG32
hWnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI32
End Type

Declare Function FindWindow32 Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Declare Function PeekMessage32 Lib "USER32" Alias "PeekMessageA" (lpMsg As MSG32, _
ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long

Declare Function TranslateMessage32 Lib "USER32" Alias "TranslateMessage" (lpMsg As MSG32) As Long
Sub procTestKey()
Dim iCount As Integer
Dim sKey As String

Application.DisplayStatusBar = True
iCount = 0
Do
iCount = iCount + 1
Application.StatusBar = "Loop: " & iCount & " Press any key to stop."
If InStr(1, Application.OperatingSystem, "32") = 0 Then
sKey = funCheckKey16
Else
sKey = funCheckKey32
End If
Loop Until sKey <> ""
MsgBox "You pressed: " & sKey
Application.StatusBar = False
End Sub
Function funCheckKey16() As String
Dim msgMessage As MSG16
Dim iHwnd As Integer
Dim i As Integer

Const WM_CHAR As Integer = &H102
Const WM_KEYDOWN As Integer = &H100
Const PM_REMOVE As Integer = &H1
Const PM_NOYIELD As Integer = &H2

funCheckKey16 = ""
iHwnd = FindWindow16("XLMAIN", Application.Caption)
i = PeekMessage16(msgMessage, iHwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE + PM_NOYIELD)
If i <> 0 Then
i = TranslateMessage16(msgMessage)
i = PeekMessage16(msgMessage, iHwnd, WM_CHAR, WM_CHAR, PM_REMOVE + PM_NOYIELD)
funCheckKey16 = Chr(msgMessage.wParam)
End If
End Function
Function funCheckKey32() As String
Dim msgMessage As MSG32
Dim iHwnd As Long
Dim i As Long

Const WM_CHAR As Long = &H102
Const WM_KEYDOWN As Long = &H100
Const PM_REMOVE As Long = &H1
Const PM_NOYIELD As Long = &H2

funCheckKey32 = ""
iHwnd = FindWindow32("XLMAIN", Application.Caption)
i = PeekMessage32(msgMessage, iHwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE + PM_NOYIELD)
If i <> 0 Then
i = TranslateMessage32(msgMessage)
i = PeekMessage32(msgMessage, iHwnd, WM_CHAR, WM_CHAR, PM_REMOVE + PM_NOYIELD)
funCheckKey32 = Chr(msgMessage.wParam)
End If
End Function[vb\]

 

[Korhan Ayhan]

Selamar,

Sn. byexcel,

İlginiz için teşekkür ederim fakat daha basit ve kısa bir yolu olabileceğini düşünüyorum.

 

[Levent Menteşoğlu]

Ekte bir örnek hazırladım. Belki isteğinizi karşılayabilir.

 

[Korhan Ayhan]

Teşekkür ederim. :arkadas: