• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

makro ile klavyeden tuş bastırma !!!!

  • Konbuyu başlatan Konbuyu başlatan osm87
  • Başlangıç tarihi Başlangıç tarihi
Katılım
25 Eylül 2011
Mesajlar
119
Excel Vers. ve Dili
2003-2007-2010 türkçe
Arkadaşlar merhabalar, aradığım şeyi forumda aratarak bulamadım olur mu onuda bilmiyorum ama olursa işimizi çok kolaylaştıracak. Çalıştığım iş yerinde sistemler gidip geldiğinde nokta vuruşlu yazıcılar sistem üzerinden aktif olmuyor. Yazıcıları 3270 ekranından Tek tek giriş yaparak aktif hale getiriyoruz. Mouse ve klavye hareketlerini kaydeden ve uygulayan programları güvenlik nedeniyle kurmamıza izin verilmiyor. Excel ile programı bulduğum bir kod ile buton atayarak çalıştırıyorum. Program çalıştıktan sonra klavyeden sırasıyla "g" , "enter", "pausebreak", "c","e", "s", "n", (cesn yazıp entera basacak) "enter", "(" (aç paranteze basacak), "s", "enter", "tab tuşu", "aşağı ok tuşu", "sağ ok tuşu", "enter", "sol ok tuşu" ... bu işlemleri yaparak 1 yazıcı aktif hale getiriliyor. Yüzlerce yazıcı var işkence haline dönüşüyor vaktimizi çok alıyor. Bu işlem exceldeki bir botona atadığım makro ile çalışması gerekiyor. Butona bastığımda program açılacak ve sırasıyla tuş kombinasyonunu yapacak böyle bir işlem olmuyorsa satırlara basacağı tuşu yazıp kopyala diyerek programı alt + tab ile geçip yapıştır gibi bir şeyde olabilir belki. Olabilirliğini bilemediğim için fikir yürütüyorum ustalardan yardım istiyorum. Kendinize iyi bakın hoşçakalın.
 
Aynı şeyi daha önce ben de denemiştim. Sonrasında hata veriyor.
 
sonrasında hata veriyor dediğiniz kısım neresi
 
Yani siyah ekran olduğu için işlem yaptırmıyor. 3270 de Script kısmında Record var ordan kayıt yapıp. play yapabilirsin.
 
Arkadaşlar merhabalar, aradığım şeyi forumda aratarak bulamadım olur mu onuda bilmiyorum ama olursa işimizi çok kolaylaştıracak. Çalıştığım iş yerinde sistemler gidip geldiğinde nokta vuruşlu yazıcılar sistem üzerinden aktif olmuyor. Yazıcıları 3270 ekranından Tek tek giriş yaparak aktif hale getiriyoruz. Mouse ve klavye hareketlerini kaydeden ve uygulayan programları güvenlik nedeniyle kurmamıza izin verilmiyor. Excel ile programı bulduğum bir kod ile buton atayarak çalıştırıyorum. Program çalıştıktan sonra klavyeden sırasıyla "g" , "enter", "pausebreak", "c","e", "s", "n", (cesn yazıp entera basacak) "enter", "(" (aç paranteze basacak), "s", "enter", "tab tuşu", "aşağı ok tuşu", "sağ ok tuşu", "enter", "sol ok tuşu" ... bu işlemleri yaparak 1 yazıcı aktif hale getiriliyor. Yüzlerce yazıcı var işkence haline dönüşüyor vaktimizi çok alıyor. Bu işlem exceldeki bir botona atadığım makro ile çalışması gerekiyor. Butona bastığımda program açılacak ve sırasıyla tuş kombinasyonunu yapacak böyle bir işlem olmuyorsa satırlara basacağı tuşu yazıp kopyala diyerek programı alt + tab ile geçip yapıştır gibi bir şeyde olabilir belki. Olabilirliğini bilemediğim için fikir yürütüyorum ustalardan yardım istiyorum. Kendinize iyi bakın hoşçakalın.

Güvenlik amacı ile programların kısıtlanması güzel bir durum.
Ancak bilgi işlemin görevi sadece kısıtlamak değil aynı zamanda işlerin kolaylaşmasını sağlamak da olmalı.

Autoit script programı ile bilgi işlem bu işlemi yapacak script i yazıp derleyip exe olarak size vermeli ve siz de kullanabilmelisiniz.
 
record kısmı çalışmıyor malesef
 
Bu dosyadaki kodu bir çalıştır

kod A,B,C, sütünlarındaki değerlere bakarak klavyedeki tuşlara basıyor
 

Ekli dosyalar

Bu dosyadaki kodu bir çalıştır

kod A,B,C, sütünlarındaki değerlere bakarak klavyedeki tuşlara basıyor

halit hocam öncelikle cevabın için teşekkür ederim. Kodu denedim g, enter kısmına kadar geliyor orada takılıyor
 
BREAK bekleme komutu yapıyor bunu silerseniz kod çalışacaktır.
 
Birde bu kodu dene kırmızı bölüm BREAK ifadesinde bekleyeceği saniyedir siz bunun zamanını arttıra bilir veya azaltabilirsiniz.



Kod:
Private Sub CommandButton1_Click()

'On Error Resume Next
Dim basla
Dim bekle

For k = 2 To 17 'Cells(Rows.Count, "b").End(3).Row
sut1 = Cells(k, "a")
sut2 = Cells(k, "b")
sut3 = Cells(k, "c")

basla = Timer
bekle = 0.4
While Timer < basla + bekle
DoEvents
Wend

If sut3 = "BREAK" Then
basla = Timer
While Timer < basla + [COLOR="Red"]2[/COLOR]
DoEvents
Wend

GoTo atla
End If

If sut3 <> "" Then SendKeys ("{" & sut3 & "}"), True: GoTo atla

If sut1 <> "" Then
SendKeys ("" & sut1 & sut2 & ""), True
Else
SendKeys (sut2), True
End If

atla:
Next

MsgBox "işlem tamam"

End Sub
 
Birde bu kodu dene kırmızı bölüm BREAK ifadesinde bekleyeceği saniyedir siz bunun zamanını arttıra bilir veya azaltabilirsiniz.



Kod:
Private Sub CommandButton1_Click()

'On Error Resume Next
Dim basla
Dim bekle

For k = 2 To 17 'Cells(Rows.Count, "b").End(3).Row
sut1 = Cells(k, "a")
sut2 = Cells(k, "b")
sut3 = Cells(k, "c")

basla = Timer
bekle = 0.4
While Timer < basla + bekle
DoEvents
Wend

If sut3 = "BREAK" Then
basla = Timer
While Timer < basla + [COLOR="Red"]2[/COLOR]
DoEvents
Wend

GoTo atla
End If

If sut3 <> "" Then SendKeys ("{" & sut3 & "}"), True: GoTo atla

If sut1 <> "" Then
SendKeys ("" & sut1 & sut2 & ""), True
Else
SendKeys (sut2), True
End If

atla:
Next

MsgBox "işlem tamam"

End Sub

halit hocam, verdiğin kodun üzerine programı açma kodu ekledim programı açıyor g ye basıyor entera basıyor sisteme giriyor. Daha sonra ekrandaki yazıları pause break tuşu ile temizlemesi lazım ki cesn yazabilsin. Ama ne oluyorsa pause break tuşuna g, enter dan sonra basamıyor. Pause break sonrasındaki kısımlarda da sorun yok. Pause break tuşunu halledersek sorun kalmıyacak.
 
Son düzenleme:
Nette arattığımda da pause break tuşu sıkıntısı oluyormuş bir şey söylemek zor bu tuşun yaptığı işlemin ekran görüntüsünü ekleyebilirmisiniz.
 
Bir de bu kodu dene

Kod:
Private Sub CommandButton1_Click()

'On Error Resume Next
Dim basla
Dim bekle

For k = 2 To 17 'Cells(Rows.Count, "b").End(3).Row
sut1 = Cells(k, "a")
sut2 = Cells(k, "b")
sut3 = Cells(k, "c")

basla = Timer
bekle = 0.4
While Timer < basla + bekle
DoEvents
Wend

If sut3 = "BREAK" Then
'SendKeys ("{" & sut3 & "}"), True
Application.SendKeys ("{" & sut3 & "}")
GoTo atla
End If

If sut3 <> "" Then SendKeys ("{" & sut3 & "}"), True: GoTo atla

If sut1 <> "" Then
SendKeys ("" & sut1 & sut2 & ""), True
Else
SendKeys (sut2), True
End If

atla:
Next

MsgBox "işlem tamam"

End Sub
 
Bir de bu kodu dene

Kod:
Private Sub CommandButton1_Click()

'On Error Resume Next
Dim basla
Dim bekle

For k = 2 To 17 'Cells(Rows.Count, "b").End(3).Row
sut1 = Cells(k, "a")
sut2 = Cells(k, "b")
sut3 = Cells(k, "c")

basla = Timer
bekle = 0.4
While Timer < basla + bekle
DoEvents
Wend

If sut3 = "BREAK" Then
'SendKeys ("{" & sut3 & "}"), True
Application.SendKeys ("{" & sut3 & "}")
GoTo atla
End If

If sut3 <> "" Then SendKeys ("{" & sut3 & "}"), True: GoTo atla

If sut1 <> "" Then
SendKeys ("" & sut1 & sut2 & ""), True
Else
SendKeys (sut2), True
End If

atla:
Next

MsgBox "işlem tamam"

End Sub

yok hocam sorun aynı. Peki sütun içindeki break değerini gir değilde g, enterdan sonra kısımda 5 saniye bekletip break tuşunu kodun içine yazsak ozaman basarmı.
 
13 nolu mesajımdaki kod bende çalışıyor hata vermiyor BREAK tuşuna basıp basmadığını bilmiyorum
 
Bu kod da bende çalışıyor

Kod:
Private Sub CommandButton1_Click()

'On Error Resume Next
Dim basla
Dim bekle


For k = 2 To 17 'Cells(Rows.Count, "b").End(3).Row
sut1 = Cells(k, "a")
sut2 = Cells(k, "b")
sut3 = Cells(k, "c")

basla = Timer
bekle = 0.4
While Timer < basla + bekle
DoEvents
Wend

If sut3 = "BREAK" Then
basla = Timer
While Timer < basla + 2
Application.SendKeys ("{" & sut3 & "}"), True
DoEvents
Wend
GoTo atla
End If

'If sut3 = "BREAK" Then
'Application.SendKeys ("{" & sut3 & "}")
'GoTo atla
'End If

If sut3 <> "" Then SendKeys ("{" & sut3 & "}"), True: GoTo atla

If sut1 <> "" Then
SendKeys ("" & sut1 & sut2 & ""), True
Else
SendKeys (sut2), True
End If

atla:
Next

MsgBox "işlem tamam"

End Sub

siz kodu nerede çalıştırıyorsanız ekran görüntüsünü bir ekleyin de bakalım
 
Bu kod da bende çalışıyor

Kod:
Private Sub CommandButton1_Click()

'On Error Resume Next
Dim basla
Dim bekle


For k = 2 To 17 'Cells(Rows.Count, "b").End(3).Row
sut1 = Cells(k, "a")
sut2 = Cells(k, "b")
sut3 = Cells(k, "c")

basla = Timer
bekle = 0.4
While Timer < basla + bekle
DoEvents
Wend

If sut3 = "BREAK" Then
basla = Timer
While Timer < basla + 2
Application.SendKeys ("{" & sut3 & "}"), True
DoEvents
Wend
GoTo atla
End If

'If sut3 = "BREAK" Then
'Application.SendKeys ("{" & sut3 & "}")
'GoTo atla
'End If

If sut3 <> "" Then SendKeys ("{" & sut3 & "}"), True: GoTo atla

If sut1 <> "" Then
SendKeys ("" & sut1 & sut2 & ""), True
Else
SendKeys (sut2), True
End If

atla:
Next

MsgBox "işlem tamam"

End Sub

siz kodu nerede çalıştırıyorsanız ekran görüntüsünü bir ekleyin de bakalım

Ekran görüntüleri ekledim. 4 nolu resimde ki ekranda pause break tuşuna basılırsa ekrandaki yazılar temizleniyor ve sonra cesn yazılabiliyor. pause break tuşu dışında başka tuşa 2 defa basarsan o ekran kilitlenip kalıyor.
 

Ekli dosyalar

Son düzenleme:
Ekran görüntülerini göremiyorum.

Acaba delete istediğinizi yapmazmı
 
Kod xp sp3 yüklü bilgisayarda ofis2003 de çalışıyor windows7 de hata veriyor.

Kod:
Private Sub CommandButton3_Click()

'On Error Resume Next
Dim basla
Dim bekle

For k = 2 To 17 'Cells(Rows.Count, "b").End(3).Row
sut1 = Cells(k, "a")
sut2 = Cells(k, "b")
sut3 = Cells(k, "c")

basla = Timer
bekle = 0.4
While Timer < basla + bekle
DoEvents
Wend

If sut3 <> "" Then SendKeys ("{" & sut3 & "}"), True: GoTo atla
If sut1 <> "" Then
SendKeys ("" & sut1 & sut2 & ""), True
Else
SendKeys (sut2), True
End If
atla:
Next

MsgBox "işlem tamam"

End Sub
 
Geri
Üst