Konu Araçları | Konu Seçenekleri | Gösterim Stili
Tarih
28/03/2019 17:33
Konu Sahibi
aliyuzen
Yorumlar
11
Okunma
336
Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 5
  • 4
  • 3
  • 2
  • 1

Derecelendirme: 0/5 - 0 oy

aliyuzen

Aktif Üye
24363
Al.... Yü....
 41
 40
 153
 02/09/2010
0
 İstanbul
 Müşteri Hizmetleri
 Ofis 2019 64 Bit
 09/05/2019,17:03
Çözüldü 
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.



ozanakkaya

Kurucu
1
Oz.... Ak....
 39
 482
 12.058
 29/01/2008
 Denizli
 Memur
 Ofis 2010 32 Bit
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

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
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

Visual Basic Code
1
2
3
4
5
6
7
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.


"Boş Örnek Eklerim, Yapıp Verirler" demeyin, örneğinizi hazırlayın.
Komplike kod talebiniz var ise İletişim bağlantısından bize ulaşın. 
Cebelleşmezsen Öğrenemezsin. 

aliyuzen

Aktif Üye
24363
Al.... Yü....
 41
 40
 153
 02/09/2010
0
 İstanbul
 Müşteri Hizmetleri
 Ofis 2019 64 Bit
 09/05/2019,17:03
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,



haliliyas

Uzman
65596
Ha.... Ya....
 Belirtilmemiş
 23
 1.033
 30/07/2014
172
 -
 
 Ofis 2019 64 Bit
 Bugün,03:59
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



aliyuzen

Aktif Üye
24363
Al.... Yü....
 41
 40
 153
 02/09/2010
0
 İstanbul
 Müşteri Hizmetleri
 Ofis 2019 64 Bit
 09/05/2019,17:03
(28/03/2019 22:39)haliliyas Adlı Kullanıcıdan Alıntı: #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?



haliliyas

Uzman
65596
Ha.... Ya....
 Belirtilmemiş
 23
 1.033
 30/07/2014
172
 -
 
 Ofis 2019 64 Bit
 Bugün,03:59
alibey kodlar neredeyse o forma/modüle yazılacak 
mesela "modül1"de aşağıdaki kodlar 64bitte çalışmıyor

Visual Basic Code
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

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
#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




Konuyu Okuyanlar: 1 Ziyaretçi

Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
Çözüldü access klavye delete tuşuna erişimi yasaklama ssdestek 21 3.370 21/08/2015, 08:20
Son Yorum: ssdestek
Çözüldü Formdaki Not alanı Enter hareketi Ömer 64 2 1.236 26/05/2014, 21:51
Son Yorum: Ömer 64
Çözüldü Giriş-Çıkış Kaydında Sadece İlk ve Son Hareketi Alıp Raporlamak SCavusoglu 2 1.639 28/04/2014, 22:30
Son Yorum: SCavusoglu
Çözüldü Toplu senet basma aydın3838 15 6.175 15/05/2013, 13:47
Son Yorum: iceman_24
Çözüldü shift tuşuna basılı tutarak açmak afatsum75 3 2.360 07/09/2012, 23:36
Son Yorum: iscinar

Türkçe Çeviri: MCTR, Yazılım: MyBB, © 2002-2019 MyBB Group.