Soru Numlock ışık sönme sorun

Katılım
5 Kasım 2006
Mesajlar
583
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
Merhaba.

Daha önce başka bir üyenin konusuna dahil olmuştum ve tam çözümü elde edememiştim.
Şimdi kendim konuyu açmak istedim rahatsızlık vermemek için.

Alttaki Api kodunu Zeki Gürsoy hocamız yazmıştı.
Ekteki A sütunundaki veriler seçilince Numlock bir yanıyor bir sönüyor.
Benim istediğim devamlı Numlock açık kalması.

Saygılar.


https://www.dropbox.com/s/5kn020vrskbe5zm/Numlock ışık kapama.xlsm?dl=0

PHP:
#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 Target.Column = 1 Then
    If Cells(Target.Row, "A") <> Empty Then
        SendKeys "%{DOWN}"
        DoEvents
        Call Numlockk
    End If
End If

End Sub
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Merhaba.
Call Numlockk satırını, üç satır aşağıya, yani End If ile End Sub satırının arasına alarak dener misiniz?
 
Katılım
5 Kasım 2006
Mesajlar
583
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
Merhaba.
Değişen birşey olmadı :(
 
Katılım
5 Kasım 2006
Mesajlar
583
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
Merhaba.
Call Numlockk satırını, üç satır aşağıya, yani End If ile End Sub satırının arasına alarak dener misiniz?
Dediğinizi yaptım.

If Not GetNumLockKey Then burdaki Not kelimesini sildim.
Ve sorun giderildi galiba.Fakat Numlock kapalıysa otomatik açılmıyor.
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Peki sizin asıl yapmak istediğiniz nedir (NumLock işlemini sormuyorum) ?
A sütunundaki bir hücreyi seçtiğinizde, bu hücreden itibaren olmak üzere A sütunundaki ilk boş hücreye mi gitmek istiyorsunuz?
Zira verdiğiniz kod aşağı ok tuşuyla aktif A sütunu hücresinden aşağı doğru tek tek ilerlenmesini sağlıyor sanırım.
 
Katılım
5 Kasım 2006
Mesajlar
583
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
Peki sizin asıl yapmak istediğiniz nedir (NumLock işlemini sormuyorum) ?
A sütunundaki bir hücreyi seçtiğinizde, bu hücreden itibaren olmak üzere A sütunundaki ilk boş hücreye mi gitmek istiyorsunuz?
Zira verdiğiniz kod aşağı ok tuşuyla aktif A sütunu hücresinden aşağı doğru tek tek ilerlenmesini sağlıyor sanırım.
Laptop ta Numlock var.Ben kendi dosyamdaki kodlarda bazı sendkeysler kullanıyorum.Bu aşağıya açılmada bir tanasi.
Sorun sadece sendkeys çalışınca ışık sönünce numaralara basılmıyor yani Numlocku manuel açmak zorunda kalıyorum.
Aslında başka bir kodla(uzun) sorun olmuyor lakin verdiğm kod kısa va kullanışlı fakat beceremedim tam yapmayı.

Alttaki kodu başka bir yabancı forumdan buldum denememde sorun olmadı hiç ve daha kullanışlı geldi bana.
Sadece bu koda göre eğer ışık kapalıysa nasıl açtırabiliriz ışığı o önemli.
Işık açıksa zaten kapanmıyor.

PHP:
#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

Const VK_NUMLOCK = &H90

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 1 Then
    NumLockState = GetKeyState(VK_NUMLOCK)
    If Cells(Target.Row, "A") <> Empty Then
       SendKeys "%{DOWN}"
       If NumLockState <> GetKeyState(VK_NUMLOCK) Then Application.SendKeys ("%{Numlock}"), True
    End If

End If

End Sub
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Cevabımın altındaki İMZA bölümünde de belirttiğim gibi; sorular gerçek belgenin KOPYASI şeklinde hazırlanmış bir örnek belge üzerinden
sorulursa daha hızlı sonuca ulaşılır.

Kullandığınız diğer kodları bilemiyoruz.
Ama NUMLOCK kapalıysa aç işlemini, verdiğiniz koddaki gibi A sütunu DOLU/BOŞ vs bakmaksızın açmak için sadece,
If NumLockState <> GetKeyStat.....satırı yeterli gibi görünüyor.

Eğer yapmak istediğiniz şey, A sütununda bir hücre seçildiğinde, bu hücre boşsa seçilen hücreden sonraki ilk boş hücreye gitmekse;
SendKey, NumLock kontrolüne gerek kalmadan, aşağıdaki şekilde istediğiniz işlem gerçekleşir.
CSS:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 And Target <> Empty Then Cells(Target.End(xlDown).Row + 1, 1).Activate
End Sub
 
Katılım
5 Kasım 2006
Mesajlar
583
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
Cevabımın altındaki İMZA bölümünde de belirttiğim gibi; sorular gerçek belgenin KOPYASI şeklinde hazırlanmış bir örnek belge üzerinden
sorulursa daha hızlı sonuca ulaşılır.

Kullandığınız diğer kodları bilemiyoruz.
Ama NUMLOCK kapalıysa aç işlemini, verdiğiniz koddaki gibi A sütunu DOLU/BOŞ vs bakmaksızın açmak için sadece,
If NumLockState <> GetKeyStat.....satırı yeterli gibi görünüyor.

Eğer yapmak istediğiniz şey, A sütununda bir hücre seçildiğinde, bu hücre boşsa seçilen hücreden sonraki ilk boş hücreye gitmekse;
SendKey, NumLock kontrolüne gerek kalmadan, aşağıdaki şekilde istediğiniz işlem gerçekleşir.
CSS:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 And Target <> Empty Then Cells(Target.End(xlDown).Row + 1, 1).Activate
End Sub
Ömer hocam.

ilk mesajdaki Dosyayı güncelledim yeni kodlar ile.
Ve orda tam anlatım sanırım.Aslında boş dolu olayı kafa karıştırmasın.
O dosyada adlar adında ad tanımlaması yaptım ve A sütunu seçilirse boş dolu farketmez seçilen satırda ad tanımlaması olanlar listeleniyor.

En son bulduğum kodla olay çözüldü sadece Numlock kapalıysa hariç.
O da sorun değil eğer çözüm olmazsa.

If NumLockState <> GetKeyStat..... burayı nasıl değiştirince olmuyor açma olayı.

PHP:
#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

Const VK_NUMLOCK = &H90

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Column = 1 Then
        NumLockState = GetKeyState(VK_NUMLOCK)
        SendKeys "%{DOWN}"
        If NumLockState <> GetKeyState(VK_NUMLOCK) Then Application.SendKeys ("%{Numlock}"), True
    End If

End Sub
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Son dosyanıza bakmadım.
Bir önceki mesajımda belirttiğim işlemin gerçekleşmesi için, aşağıdaki gibi olması lazım.
Zira kullanılan GetKeyState(VK_NUMLOCK) değişkenin tanımlaması da olmalı.
PHP:
#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

Const VK_NUMLOCK = &H90

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     If Target.Column = 1 And Target <> Empty Then Cells(Target.End(xlDown).Row + 1, 1).Activate
End Sub
 
Üst