numlock butonunun kapanması

[incsoft]

Arkadaşlar aşağıdaki komutu kullanınca nedense Numlock butonu devre dışı kalıyor bu sebepten dolayı If NumLock = True Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}" bu şekilde bir kod bulmuştum oda işimi görmedi. Başka nasıl kapanmamasını sağlarım?

Teşekkürler..

Sub DÜZENLE()
Dim Alan As Range
For Each Alan In Range("K142:Q144,K146:Q148,I151:J160,K151:L160,M151:M160,Q151:Q156,Q158:Q160")
Alan.Select
DoEvents
SendKeys "{F2}", True
SendKeys "{ENTER}", True
If NumLock = True Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"
Next
End Sub

 

[Haluk]

Siz klavyenin sağ tarafındaki "nümerik tuş takımına" basılınca, nümerik tuşlar çalışmasın mı istiyorsunuz?

.

 

[incsoft]

Siz klavyenin sağ tarafındaki "nümerik tuş takımına" basılınca, nümerik tuşlar çalışmasın mı istiyorsunuz?

.

Normal de benim bu komutu kullanmadan önce sağ taraf tuşlarım çalışıyor ancak bu komutu kullanınca nedense devre dışı kalıyor. Benim amacım bu komut sonunda devre dışı kalmaması.

SM-G935F cihazımdan Tapatalk kullanılarak gönderildi

 

[Haluk]

Aşağıdaki kod, nümerik tuş takımının kilidini açar ....

Sub Test()
    'Haluk -03/01/2019
    'E-posta: sa4truss@gmail.com
    '
    Dim objWord As Object
    Set objWord = CreateObject("Word.Application")
    If objWord.numlock = False Then Application.SendKeys "{NUMLOCK}"
    Set objWord = Nothing
End Sub

.

 

[incsoft]

Aşağıdaki kod, nümerik tuş takımının kilidini açar ....

Sub Test()
'Haluk -03/01/2019
'E-posta: sa4truss@gmail.com
'
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
If objWord.numlock = False Then Application.SendKeys "{NUMLOCK}"
Set objWord = Nothing
End Sub

.

Teşekkürler Haluk bey. Benim kodumun içine adapte edebilmeniz mümkünmüdür? Yarın deneyeceğim.

SM-G935F cihazımdan Tapatalk kullanılarak gönderildi

 

[Haluk]

Kendi kodunuzla aynı modüle, yukarıda verdiğim kodları yapıştırın ve kendi kodunuzdaki aşağıdaki satırı silin;

If NumLock = True Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"

Kodunuzdaki "End Sub" satırının hemen üzerine, aşağıdakini yazın....

Call Test

Böylece; eğer "nümerik tuş takımının" kilidi kapalıysa, açılacaktır.

.

 

[incsoft]

Kendi kodunuzla aynı modüle, yukarıda verdiğim kodları yapıştırın ve kendi kodunuzdaki aşağıdaki satırı silin;

If NumLock = True Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"

Kodunuzdaki "End Sub" satırının hemen üzerine, aşağıdakini yazın....

Call Test

Böylece; eğer "nümerik tuş takımının" kilidi kapalıysa, açılacaktır.

.

Sub DÜZENLE()
Dim Alan As Range
For Each Alan In Range("K142:Q144,K146:Q148,I151:J160,K151:L160,M151:M160,Q151:Q156,Q158:Q160")
Alan.Select
DoEvents
SendKeys "{F2}", True
SendKeys "{ENTER}", True
If NumLock = True Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"
Next
Call Test
End Sub



maalesef hocam hata verdi

 

[FERAZ]

Merhaba.
Benim denemelerimde çalışıyor fakat kod F2+Enter olayı için yavaş çalışıyor.
Kod alttaki satırda yavaşlıyor.
Acaba Haluk hocam bu Word officenin yazı yazma olayımı?
Yani bu word harici başka bişey olmuyormu hız için.

If NumLock = True Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}" burayı simelisiniz inscsoft üstad bu arada.
Call Test bunu next satırının üstüne yapıştırıpta deneyebilirsiniz silip.
Denemelerimde kod çok yavaş çalışıyor.

Set objWord = CreateObject("Word.Application")

 

[FERAZ]

Sub DÜZENLE()
Dim Alan As Range
For Each Alan In Range("K142:Q144,K146:Q148,I151:J160,K151:L160,M151:M160,Q151:Q156,Q158:Q160")
Alan.Select
DoEvents
SendKeys "{F2}", True
SendKeys "{ENTER}", True
If NumLock = True Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"
Next
Call Test
End Sub



maalesef hocam hata verdi

Alttaki gibi hata vermez.

Sub Test()
'Haluk -03/01/2019
'E-posta: sa4truss@gmail.com
'
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
If CreateObject("Word.Application").numlock = False Then Application.SendKeys "{NUMLOCK}"
Set objWord = Nothing
End Sub


Sub DÜZENLE()

Dim Alan As Range
For Each Alan In Range("K142:Q144,K146:Q148,I151:J160,K151:L160,M151:M160,Q151:Q156,Q158:Q160")
Alan.Select
DoEvents

SendKeys "{F2}", True
SendKeys "{ENTER}", True

Next
Call Test
End Sub

 

[FERAZ]

Aşağıdaki kod, nümerik tuş takımının kilidini açar ....

Sub Test()
    'Haluk -03/01/2019
    'E-posta: sa4truss@gmail.com
    '
    Dim objWord As Object
    Set objWord = CreateObject("Word.Application")
    If objWord.numlock = False Then Application.SendKeys "{NUMLOCK}"
    Set objWord = Nothing
End Sub

.

Sayın Haluk hocam cevap gelmedi sizden bir daha sorayım benim içinde önemli bir konu bu.
Bu word haricince başka yol yokmu testlerimde bazen başka bir word dosya açık die hata veriyor eğer başka bir word dosya açarsam.

 

[Zeki Gürsoy]

Her ne kadar API sevilmese de, çoğu zaman ben tercih ederim.

Düzenleme: CapsLock yerine NumLock olarak değiştrildi.

#If Win64 Then
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
#Else
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
#End If
   
Sub Test3()
    'NumLock kapalı ise aç...
    If Not GetNumLockKey Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"
End Sub

Private Function GetNumLockKey() As Boolean
    GetNumLockKey = GetKeyState(vbKeyNumlock)
End Function

 

[FERAZ]

Yarın deneyeceğim nasipse Zeki bey.
Kod çalışsında varsın Api olsun

 

[Zeki Gürsoy]

Kod düzgün çalışıyor, dosyanıza montalayın yeterli. İyi geceler...

 

[FERAZ]

Tamam hocam.Sizede iyi geceler.

 

[Haluk]

Sayın Haluk hocam cevap gelmedi sizden bir daha sorayım benim içinde önemli bir konu bu.
Bu word haricince başka yol yokmu testlerimde bazen başka bir word dosya açık die hata veriyor eğer başka bir word dosya açarsam.

Zeki Bey size alternatifi vermiş, probleminiz muhtemelen çözülmüştür.

Ancak, şunu da belirteyim ki; 4 No'lu mesajda verdiğim kod gayet güzel çalışıyor..... zaten hazırladıktan sonra deneyip de göndermiştim. Siz o kodu biraz değiştirip de kullanmışınız, belki de kendi diğer kodlarınızdan dolayı hata alıyorsunuzdur.

.

 

[FERAZ]

Zeki Bey size alternatifi vermiş, probleminiz muhtemelen çözülmüştür.

Ancak, şunu da belirteyim ki; 4 No'lu mesajda verdiğim kod gayet güzel çalışıyor..... zaten hazırladıktan sonra deneyip de göndermiştim. Siz o kodu biraz değiştirip de kullanmışınız, belki de kendi diğer kodlarınızdan dolayı hata alıyorsunuzdur.

.

Haluk hocam değiştirmeden kullandım sizin kodu ve harika çalışıyordu.
Sadece öncedende dediğim gibi kod çalışınca galiba arka planda word açılıyor hatta hata mesajıda paylaşırım tekrar olursa.
Birde Zeki hocamınkini deneyeceğim birazdan.

 

[FERAZ]

Her ne kadar API sevilmese de, çoğu zaman ben tercih ederim.

Düzenleme: CapsLock yerine NumLock olarak değiştrildi.

#If Win64 Then
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
#Else
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
#End If
  
Sub Test3()
    'NumLock kapalı ise aç...
    If Not GetNumLockKey Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"
End Sub

Private Function GetNumLockKey() As Boolean
    GetNumLockKey = GetKeyState(vbKeyNumlock)
End Function

Zeki hocam kodu alttaki gibi yaptım F2+Enter için.
Fakat kodu butona ekleyip çalıştırınca ışık bir yanıyor bir sönüyor kodu çalıştırınca.
Yani ilk çalıştırmada normal ikincide ise ışık sönüyor.

#If Win64 Then
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
#Else
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
#End If
  
Sub Test3()
    'NumLock kapalý ise aç...
    If Not GetNumLockKey Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"
End Sub

Private Function GetNumLockKey() As Boolean
    GetNumLockKey = GetKeyState(vbKeyNumlock)
End Function

Sub DÜZENLE()

    Dim Alan As Range
    For Each Alan In Range("A1:A20,B1:B20")
        Alan.Select
        DoEvents
        SendKeys "{F2}", True
        SendKeys "{ENTER}", True
    Next
  
    Range("A1").Select
    Call Test3
End Sub

 

[FERAZ]

Zeki Bey size alternatifi vermiş, probleminiz muhtemelen çözülmüştür.

Ancak, şunu da belirteyim ki; 4 No'lu mesajda verdiğim kod gayet güzel çalışıyor..... zaten hazırladıktan sonra deneyip de göndermiştim. Siz o kodu biraz değiştirip de kullanmışınız, belki de kendi diğer kodlarınızdan dolayı hata alıyorsunuzdur.

.

Kodu birçok denemiştim ve dediğim hatalar oluşmamıştı.
Bilgisayarı kapatıp açınca çalışan kod kada word dosya açıldı ve hata resimleri altta.

 

[Zeki Gürsoy]

"DÜZENLE" içinde, Range("A1").Select den sonra DoEvents ekleyin ki, Selection_Change olayının çalışmasına izin versin.

 

[FERAZ]

Zeki hocam kodu dediğiniz gibi yaptım orda çaloştı lakin.
Alttaki kod için çalışmıyor.
Diyelim A sütununda veriler var onlara tıklayınca bir yanıyor bir sönüyor makina.

#If Win64 Then
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
#Else
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
#End If
  
Sub Numlockk()
    'NumLock kapaly ise aç...
    If Not GetNumLockKey Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"
End Sub

Private Function GetNumLockKey() As Boolean
    GetNumLockKey = GetKeyState(vbKeyNumlock)
End Function


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Cells(Target.Row, "A") <> Empty Then
        SendKeys "%{DOWN}"
        DoEvents
        Call Numlockk
    End If

End Sub