Caps Lock Tuşunu Otomatik Açmak

[betoncu]

Excelde dosyanın her açılışında caps lock tuşunu aktif yapan bir makro varmıdır?
Yardımlarınızı bekliyorum...

 

[Mahmut Bayram]

Sub auto_open()
CreateObject("Wscript.Shell").SendKeys "{CAPSLOCK}"
End Sub

Ekteki dosyada caps lockun açık veya kapalı olduğunu kontrol eder.

 

[betoncu]

Merhaba Mahmut bey yardımınız için teşekkür ederim. Yalnız bu verdiğiniz kod tam olarak işimi görmedi.
Bu kod ile açılıştı mevcut durum tersine dönüyor. Caps Lock açıksa kapatıyor. Kapalıysa açıyor.
Caps Lock açıkken de durumu açık olarak seçen bir kod yokmudur acaba?
Yardımlarınızı bekliyorum...

 

[Zeki Gürsoy]

Bu şekilde deneyin.

Private Declare Function GetKeyState Lib _
        "user32" (ByVal nVirtKey As Long) As Long
    
Private Function GetCapsLockKey() As Boolean
    GetCapsLockKey = GetKeyState(vbKeyCapital)
End Function


Sub test()
If GetCapsLockKey Then _
    CreateObject("Wscript.Shell").SendKeys "{CAPSLOCK}"
End Sub

 

[betoncu]

Zeki bey bu kod da direk açık olan caps locu kapatıyor..

 

[betoncu]

Bu konuda yardım edecek kimse yokmu acaba??

 

[Zeki Gürsoy]

Zeki bey bu kod da direk açık olan caps locu kapatıyor..

Küçük bir eksik vardı.

Private Declare Function GetKeyState Lib _
        "user32" (ByVal nVirtKey As Long) As Long
    
Private Function GetCapsLockKey() As Boolean
    GetCapsLockKey = GetKeyState(vbKeyCapital)
End Function


Sub test()
If [COLOR=Blue][B]Not[/B][/COLOR] GetCapsLockKey Then _
    CreateObject("Wscript.Shell").SendKeys "{CAPSLOCK}"
End Sub

 

[betoncu]

SORUN ÇIKTI:
Açılışta otomatik çalışması için açılmasını istediğim diğer kodların bulunduğu Autpen isimli makroya ekledim.

Private Declare Function GetKeyState Lib _
"user32" (ByVal nVirtKey As Long) As Long
olarak yazan satırda uyar veriyor.
Ne yapmam lazım acaba?

 

[Korhan Ayhan]

Selamlar,

Hata veren satırı Autpen ile başlayan satırın üstüne yazın. Yani bu satır kodların en üst kısmında olmalı.

Autpen içeren modülünüzü aşağıdaki şekilde düzenlemelisiniz.

Private Declare Function GetKeyState Lib _
"user32" (ByVal nVirtKey As Long) As Long
 
Private Function GetCapsLockKey() As Boolean
GetCapsLockKey = GetKeyState(vbKeyCapital)
End Function
 
[LEFT]Sub Auto_Open()[/LEFT]
If [COLOR=black]Not[/COLOR] GetCapsLockKey Then CreateObject("Wscript.Shell").SendKeys "{CAPSLOCK}"
[COLOR=red]'Sizin kodlarınız...[/COLOR]
[LEFT]End Sub[/LEFT]

 

[Mahmut Bayram]

Alternatif.
Ekteki örneği inceleyiniz.

 

[Mahmut Bayram]

Değişik bir alternatif.
Bu kodlarda açık veya kapalı olduğunu belirtir.

Option Explicit
 
Private Declare Function GetKeyState Lib _
"user32" (ByVal nVirtKey As Long) As Integer
 
Public Function CapsLockOn() As Boolean
    Dim iKeyState As Integer
    iKeyState = GetKeyState(vbKeyCapital)
    CapsLockOn = (iKeyState = 1 Or iKeyState = -127)
End Function
 
Sub Auto_Open()
   If CapsLockOn() Then
      MsgBox "CapsLock Açık"
   Else
      MsgBox "CapsLock Kapalı"
   End If
End Sub

 

[betoncu]

Mahmutt bey teşekkür ederim emeğinize sağlık....

 

[Mahmut Bayram]

Rica ederim.

 

[kadir78]

İyi günler. Bu konuda capslock ve numlock tuşları için nasıl düzenleme yapabiliriz.

 

[Korhan Ayhan]

Deneyiniz.

Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Private Const kCapital = 20
Private Const kNumlock = 144

Public Function CapsLock() As Boolean
    CapsLock = KeyState(kCapital)
End Function

Public Function NumLock() As Boolean
    NumLock = KeyState(kNumlock)
End Function

Private Function KeyState(lKey As Long) As Boolean
    KeyState = CBool(GetKeyState(lKey))
End Function

Sub Test()
    If CapsLock = False Then CreateObject("Wscript.Shell").SendKeys "{CAPSLOCK}"
    If NumLock = True Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"
End Sub

 

[kadir78]

Korhan Hocam çok teşekkür ederim kodlar çalıştı. Elinize Emeğinize sağlık. İyi akşamlar.

 

[Tevfik_Kursun]

Çok teşekkürler arkadaşlar
Saygılarımla