program beklemesinden esc ile çıkılabilmesi

[merakli_72]

mrb,
Aşağıdaki sub baska sublar tarafından sürekli çağrılıyor
bu çağrımdan kurtulmak için aşağıda görüldüğü gibi ESC tuşuna basmak gerekiyor, ESC tuşuba basınca hata oluşuyor ve on error ile program sonlandırılıyor buraya kadar sorun yok.
Fakat aynı zamanda bu sub içinde sleep 1800000 ile 3 dakikada beklemekte gerekiyor, sorunda burda başlıyor ESC tuşuna basılsa bile sleep komutu ile belirtilen bekleme gerçekleştikten sonra program sonlanıyor.
Yani sub çağrılmaya başlayalı 30 saniye olduktan sonra ESC tuşuna basılırsa programdan çıkış için daha 2.5 dakika beklemek gerkiyor
program çalışmasını istediğim kadar bekletebileyim fakat aynı zamanda ESC tuşuna basıncada (başka tuşta olabilir) program sonlansın boyle birşey nasıl yapılabilir.
Teşekkürler

sub islem

On Error GoTo 10


Application.EnableCancelKey = xlErrorHandler

Application.DisplayFullScreen = True


......................
......................................
............

'Application.Wait Now + TimeValue("00:" & Sheets("Tanımlar").Cells(3, 2) & ":00")

Sleep 180000
Exit Sub




10:


Sheets("Sonuc").Select
Application.DisplayFullScreen = False
Application.EnableCancelKey = xlInterrupt


End
End Sub

 

[merakli_72]

Arkadaşlar ESC ile mümkün değilse başka bir tuş yada tuş bileşenide işimi görür, önemli olan beklemeden istendiğinde döngüden çıkılabilmesi

 

[merakli_72]

mrb,

Application.Wait ... konumunda ESC tuşuna basınca program bir alt satırdan devam ediyor
bende aşağıdaki gibi bir kontrolle işi çözdüm, yani beklemesi gereken süreden daha önce alt satıra indiyse ESC tuşua basılmıştır gibi bir mantık, belki başkalarınada lazım olur

Bekleme_Suresi = Time
Application.Wait Bekleme_Suresi +TimeValue("00:05:00")

If Time >= Bekleme_Suresi + TimeValue("00:05:00")
Exit Sub ' yani işleme devam et, süre dolmadıysa aşağıya doğru devam et program sonlanır
End If



Hata:
end