Seçili Hücrede F2+Enter İşlemi

[betoncu]

Modüle 1 bulunan yenile makrosu G sütununda F2+Enter işleminin yapılmasını sağlıyor.

Kodu:

Sub yenile()
For i = 1 To [g65536].End(3).Row
Cells(1, "g").Select
SendKeys "{F2}"
SendKeys "{ENTER}"
Next
End Sub


Sorum şu: excel sayfasında hangi hücre seçiliyse o hücrenin bulunduğu satır ile G sütunu kesişimindeki hücrede F2+Enter işlemini yapacak koda ihtiyacım vardır. Yardımlarınızı bekliyorum.

 

[hamitcan]

Kod içindeki satırı aşağıdaki şekilde değiştirip deneyin.

Cells(activecell.row, "g").Select

 

[betoncu]

Kod içindeki satırı aşağıdaki şekilde değiştirip deneyin.

Cells(activecell.row, "g").Select

Hamitcan bey teşekkür ederim. Yardımınızla kodu aşağıdaki şekilde değiştirerek uyguladım.

Sub yenile()
Cells(ActiveCell.Row, "g").Select 'Seçilen satırdaki G hücresini seçer.
SendKeys "{F2}" ' Seçilen hücrede f2 tuşunu tetikler
SendKeys "{ENTER}" ' Seçilen hücreyi enter ile geçer
End Sub

 

[hamitcan]

İşinizi gördü mü ?

 

[betoncu]

İşinizi gördü mü ?

Evet çok işime yaradı. Tekrar teşekkür ederim..

 

[ottoman005]

İşinizi gördü mü ?

Peki hocam varsayalım f hücresine gelince f2 aktif olsa çünkü önceden kayitli metin var sonuna ekleme yapıyorum elimle f2 tuşuna basarak f hücresine gerekli veriyi girdikten sonra enter layınca alt hucreye ve var olan hucrede kalmasada yan hucreye geçse yani g sütununa orda yine f2 aktif olsa bunun yapmanız mümkündür hocam

 

[necati]

Peki hocam varsayalım f hücresine gelince f2 aktif olsa çünkü önceden kayitli metin var sonuna ekleme yapıyorum elimle f2 tuşuna basarak f hücresine gerekli veriyi girdikten sonra enter layınca alt hucreye ve var olan hucrede kalmasada yan hucreye geçse yani g sütununa orda yine f2 aktif olsa bunun yapmanız mümkündür hocam

Sn ottoman005 imleç hücrede kalıyorsa, diğer hücreye geçmiyorsa, bunun sebebi ayarlardadır.
* Seçenekler
* Gelişmiş
* Enter'a bastıktan sonra seçimi taşı kutucuğuna tik işareti koyun ve altındaki yönlerden birini seçin.
* Tamam
Sorunuzun devamı için diğer kullanıcılar veya destek ekibi yardım edeceklerdir.

 

[ottoman005]

Enter ile sağa geçme işlemi oldu sağolun hocam 2 sorum ise c13 veri grince (F13 )( G13 ) hücrelerine veri geliyor önce C13 ve F13 arasındaki hücreleri elle dolduruyorum tab tuşu ile F13 gelince vba ile atanan değerin yanına örnek : ALS21000045 gibi değerinin yanına 5 tane daha sayiyi elle girmem gerekli bunun için f13 f70 g13 g70 arasında f2 tuşları aktif olmalı bunun için bir makro kodu lazım şimdiden teşekkürler

 

[necati]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim hcr As Range

Set hcr = Range("F13:G70")
If Not Application.Intersect(hcr, Range(Target.Address)) Is Nothing Then
    Application.SendKeys "{F2}"
End If

End Sub

 

[ottoman005]

Kusura bakmayın Private Sub Worksheet_Change(ByVal Target As Range) adi altında çalışan başka kodlar var altına şu şekilde yapıştırdım fakat şu hatayı verdi
Dim hcr As Range

Set hcr = Range("F13:G70")
If Not Application.Intersect(hcr, Range(Target.Address)) Is Nothing Then
Application.SendKeys "{F2}"
Compile error
Block If without End if bu hatayı aldim

 

[necati]

Kusura bakmayın Private Sub Worksheet_Change(ByVal Target As Range) adi altında çalışan başka kodlar var altına şu şekilde yapıştırdım fakat şu hatayı verdi
Dim hcr As Range

Set hcr = Range("F13:G70")
If Not Application.Intersect(hcr, Range(Target.Address)) Is Nothing Then
Application.SendKeys "{F2}"
Compile error
Block If without End if bu hatayı aldim

if bloğunun kapatılmasını yapan End if satırını kopyalamamışınız.

Sanırım sizin için Worksheet_Change değil de Worksheet_SelectionChange kullanmak daha uygun olacaktır:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim hcr As Range

Set hcr = Range("F13:G70")
If Not Application.Intersect(hcr, Range(Target.Address)) Is Nothing Then
    Application.SendKeys "{F2}"
End If
End Sub

 

[ottoman005]

if bloğunun kapatılmasını yapan End if satırını kopyalamamışınız.

Sanırım sizin için Worksheet_Change değil de Worksheet_SelectionChange kullanmak daha uygun olacaktır:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim hcr As Range

Set hcr = Range("F13:G70")
If Not Application.Intersect(hcr, Range(Target.Address)) Is Nothing Then
    Application.SendKeys "{F2}"
End If
End Sub

Mükemmel olmuş elinize emeğinize sağlık harikasınız Allah razı olsun tebrikler ustalarım

 

[ottoman005]

Mükemmel olmuş elinize emeğinize sağlık harikasınız Allah razı olsun tebrikler ustalarım

Sayın necati hocam en son vermiş olduğunuz kod mükemmel çalışıyor eğer mümkünse numlock ve caps lock tuşu excel açılınca kapalı olup olmadığını kontrol edip otomatik açılmasını sağlayacak kodu bunun içine dahil.etmeniz mümkün mü. Bir kaçtan buldum excel kasıldı office 365 için şimdiden teşekkürler kıymetli hocam

 

[Sezgin Ulu]

Değerli bilgiler için teşekkürler hocam, elinizi sağlık.

 

[necati]

Sayın necati hocam en son vermiş olduğunuz kod mükemmel çalışıyor eğer mümkünse numlock ve caps lock tuşu excel açılınca kapalı olup olmadığını kontrol edip otomatik açılmasını sağlayacak kodu bunun içine dahil.etmeniz mümkün mü. Bir kaçtan buldum excel kasıldı office 365 için şimdiden teşekkürler kıymetli hocam

İki makroyu birleştirmek çalışma prensiplerine göre uygun olmayacaktır. Çünkü önceki makromuz her hareketi konrol ediyor, bu arada numlock ve caps lock için de devamlı kontrol yapması uygun olmayacaktır. 2007 versiyon için denenmiştir. Bu çalışma kitabı koduna yazılacak kodu paylaşıyorum.

#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

Private Sub Workbook_Open()
     If (GetKeyState(vbKeyCapital) = 0) Then
        CreateObject("Wscript.Shell").SendKeys "{CAPSLOCK}"
     End If
     If (GetKeyState(vbKeyNumlock) = 0) Then
        CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"
     End If
End Sub

 

[ottoman005]

Hocam capslock oldu fakat numlock tuşu sutun degiştirirken bile kapanıyor sürekli açık kalmasını istiyorum zahmet olmassa Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long bu satır kırmızı yaniyor acaba sorun bununlamı alakalı acaba

 

[necati]

Hocam capslock oldu fakat numlock tuşu sutun degiştirirken bile kapanıyor sürekli açık kalmasını istiyorum zahmet olmassa Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long bu satır kırmızı yaniyor acaba sorun bununlamı alakalı acaba

Buradaki kırmızılık hata değil, 32/64 bit denetimi yapıldığından sizin sistem olmayan durum satırı kırmızı görünüyor.
"F2" tuşu ile "Numlock" tuşları birlikte olunca sanki "bug" var gibi "Numlock" tuşu kararsız hale geliyor.
Yeni bulduğum şu kodlarla deneyelim, ben olumlu sonuç aldım.

#If Win64 Then
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#Else
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#End If

Const VK_NUMLOCK = 144
Const VK_CAPITAL = 20
Dim xOldNLState As Long
Dim xOldCLState As Long
Const KEY_MASK As Integer = &HFF80 '

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Set hcr = Range("F13:G70")
If (GetKeyState(vbKeyShift) And KEY_MASK) <> 0 Then Exit Sub
If Not Application.Intersect(hcr, Range(Target.Address)) Is Nothing Then
    xOldNLState = GetAsyncKeyState(VK_NUMLOCK)
    xOldCLState = GetAsyncKeyState(VK_CAPITAL)
    SendKeys "{F2}"
        
        If GetAsyncKeyState(VK_NUMLOCK) <> xOldNLState Then
            Application.SendKeys "{NUMLOCK}"
        End If
        
        If GetAsyncKeyState(VK_CAPITAL) <> xOldCLState Then
            Application.SendKeys "{CAPSLOCK}"
        End If

End If
End Sub

 

[Korhan Ayhan]

Excelde VBA tarafında SendKeys kullanımı böyle sıkıntılar çıkarabiliyor.

Aşağıdaki gibi bir çözüm buldum. Belki sizde çalışır..

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("F13:G70")) Is Nothing Then
        Application.SendKeys "{F2}", True
        DoEvents
        Application.SendKeys "{F2}", True
    End If
End Sub

 

[necati]

Korhan bey desteğiniz için teşekkürler.

 

[Korhan Ayhan]

Ayrıca benzer sorunlar için arşivdeki konularda önerilen çözümlerde belki işe yarayabilir.

Sorgu için arama sonuçları: numlock

www.excel.web.tr