Esc Tuşuna Basma Hareketi - aliyuzen - 28/03/2019
Merhaba,
Esc tuşuna basmadan kod ile esc tuşuna basmış gibi yapabilir miyiz? sitede bir kaç esc tuşu ile kodları buldum denedim ama olmadı.
Bir mesajım var. Mesaj okuyup tamam dedikten sonra, 3 kez esc tuşuna basmış gibi davranan bir form istiyorum.
Şu anda msgbox "Deneme" çıkıyor, sonrasında esc ve esc tuşlarna ben basıyorum.
esc tuşunu gönderen bir kod var mı? Teşekkürler.
Cvp: Esc Tuşuna Basma Hareketi - ozanakkaya - 28/03/2019
Merhaba, sendkeys kodunun çalışabilmesi için formun tuş gönder özelliğinin Evet olarak seçilmesi gerekli.
Mesaj kutusu için
msgbox "deneme" yerine
If MsgBox("test", vbOKOnly) = vbOK Then
end if
şeklinde kod ekleyip, tamam butonunun tıklanma olayının sonrasına ekleme yaptırabilirsiniz.
Yeni modül oluşturun, modüle
Option Compare Database
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
' API declarations:
Private Declare Function GetVersionEx Lib "Kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwflags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetKeyboardState Lib "user32" _
(pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" _
(lppbKeyState As Byte) As Long
' Constant declarations:
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_CAPITAL = &H14
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1
Function IsCapsLockOn() As Boolean
Dim o As OSVERSIONINFO
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
IsCapsLockOn = keys(VK_CAPITAL)
End Function
Sub ToggleCapsLock()
Dim o As OSVERSIONINFO
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '=====Win95
'Toggle capslock
keys(VK_CAPITAL) = Abs(Not keys(VK_CAPITAL))
SetKeyboardState keys(0)
ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then '=====WinNT
'Simulate Key Press>
keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY _
Or KEYEVENTF_KEYUP, 0
End If
End Sub
Function IsNumLockOn() As Boolean
Dim o As OSVERSIONINFO
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
IsNumLockOn = keys(VK_NUMLOCK)
End Function
Sub ToggleNumLock()
Dim o As OSVERSIONINFO
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '=====Win95
keys(VK_NUMLOCK) = Abs(Not keys(VK_NUMLOCK))
SetKeyboardState keys(0)
ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then '=====WinNT
'Simulate Key Press
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY _
Or KEYEVENTF_KEYUP, 0
End If
End Sub
Function IsScrollLockOn()
Dim o As OSVERSIONINFO
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
IsScrollLockOn = keys(VK_SCROLL)
End Function
Sub ToggleScrollLock()
Dim o As OSVERSIONINFO
o.dwOSVersionInfoSize = Len(o)
GetVersionEx o
Dim keys(0 To 255) As Byte
GetKeyboardState keys(0)
If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '=====Win95
keys(VK_SCROLL) = Abs(Not keys(VK_SCROLL))
SetKeyboardState keys(0)
ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then '=====WinNT
'Simulate Key Press
keybd_event VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'Simulate Key Release
keybd_event VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
End If
End Sub
Sub mySendKeys(sKeys As String, Optional bWait As Boolean = False)
Dim bNumLockState As Boolean
Dim bCapsLockState As Boolean
Dim bScrollLockState As Boolean
bNumLockState = IsNumLockOn()
bCapsLockState = IsCapsLockOn()
bScrollLockState = IsScrollLockOn()
SendKeys sKeys, bWait
If IsNumLockOn() <> bNumLockState Then
ToggleNumLock
End If
If IsCapsLockOn() <> bCapsLockState Then
ToggleCapsLock
End If
If IsScrollLockOn() <> bScrollLockState Then
ToggleScrollLock
End If
End Sub
Function fSendKeys(sKeys As String, Optional bWait As Boolean = False)
' Function to make it callable from macros
mySendKeys sKeys, bWait
End Function
kodları ekleyip modülü kaydedin.
msgbox kodunu da
If MsgBox("test", vbOKOnly) = vbOK Then
fSendKeys "{ESC}", False
fSendKeys "{ESC}", False
fSendKeys "{ESC}", False
End If
şeklinde değiştirin. Sonuç olumsuz ile örnek uygulamayı ekleyin test edelim.
Cvp: Esc Tuşuna Basma Hareketi - aliyuzen - 28/03/2019
Değerli Üstadım,
Dosyayı bağlı tablo yöneticisinden linklerseniz sevinirim.
SendKeys "{ESC}", NO
kodu yeterli olabilir mi hocam.
sizin modülü denedim. modül 32 bite uygun sanırım. Hata verince, çalışmadı silmek zorunda kaldım.
Siz bir modül ve bir form ekleyebilirsiniz. Ben gerekli olan formumdaki mesaj kutuma o kodu ve modülü taşırım.
Bir de teklif_t_f formundaki yüklü dosyalar sekmesinde yükle butonum çalışıyordu. 64 bit versiyona bugün geçince o da çalışmaz oldu.
Ancak, hocam, bu projemdeki tüm modüllerin hem 32bit hem de 64 bitte çalışması lazım. İş yerinde kuracağım pc ler 32 ve 64 olarak değişiyor. Ve nasıl yapacağımı ne yazık ki bilmiyorum.
Dosya ekte hocam...
Saygılarımla,
Cvp: Esc Tuşuna Basma Hareketi - berduş - 28/03/2019
hem 32 hem de 64 bitte çalışmasını sağlayacak kod
_____________________________
#If VBA7 And Win64 Then '64 bit için
….. Declare PtrSafe…..
#Else '32 bit için
…. Declare …………...
#End If
________________________________
temel mantık sorunlu kodları 2 defa yazmak
32 bitte "Declare " olan yerler
64 bitt "Declare PtrSafe " olacak
____________________________________
bir şeyler yapmaya çalıştım "teklif_t_f " formunda "esc"ye bas mesajlarının sonuna sizin yazdığınız kodu ekledim
ama yükle kısmında belki de dosya olmadığından çalışmadı o kısmına o nedenle dokunmadım
dilerim işinize yarar
Cvp: Esc Tuşuna Basma Hareketi - aliyuzen - 29/03/2019
(28/03/2019, 22:39)haliliyas yazdı: #If VBA7 And Win64 Then '64 bit için
….. Declare PtrSafe…..
#Else '32 bit için
…. Declare …………...
#End If Üstadım,Aşağıdaki kodu nereye yazmam gerekiyor.Sanırım, iki farklı formumum olması lazım. 32 bit için ve 64 bit için olan... Doğru mu anladım?
Cvp: Esc Tuşuna Basma Hareketi - berduş - 29/03/2019
alibey kodlar neredeyse o forma/modüle yazılacak
mesela "modül1"de aşağıdaki kodlar 64bitte çalışmıyor
Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
bu durumda kodu "modül1"e yazacağız. hem 64 hem de 32bitte çalışması için kodu aşağıdaki gibi düzenlemeliyiz
#If VBA7 And Win64 Then '64 bit için kodlar
Declare PtrSafe Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare PtrSafe Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare PtrSafe Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
#Else '32 bit için kodlar
Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
#End If
bu durumda Access 64 bit olan sistemde
#If VBA7 Then...
#Else arasındaki kodları 32bitte ise diğer kodları kullanır aradaki tek fark 64bitlik kısımda "ptrsafe" olmasıdır
|