AccessTr.neT

Tam Versiyon: Esc Tuşuna Basma Hareketi
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2
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.
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.
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,
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
(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?
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
Sayfalar: 1 2