Seçili Hücreye Bağlı Satır Dondurma

[cenkataseven]

Merhaba,

Benim belirleyeceğim hücreler tıkladığımda, tıkladığım hücrenin satırının dondurulmasını sağlayamıyorum.

Örneğin;

A5, A17, A55 hücrelerinden hangisine tıklarsam, o satır sabit kalacak şekilde freeze komutunun devreye girmesini istiyorum.

Bu yapılabilir mi?

Teşekkürler

 

[antonio]

Sayfanın kod penceresine aşağıdaki kodları yapıştırınız.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [A5,A17,A55]) Is Nothing Then
    Target.Offset(1, 0).Select
    ActiveWindow.FreezePanes = True
End If
End Sub

 

[antonio]

Dondurulan hücreleri çözmek için ise, belirttiğiniz hücrelerin hizasındaki B sütununda aynı satırlara çitf tıklarsanız aşağıdaki kodlarla satır dondurma işlemi iptal olacaktır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, [[COLOR="Red"][B]B5,B17,B55[/B][/COLOR]]) Is Nothing Then
    Target.Offset(1, 0).Select
    ActiveWindow.FreezePanes = False
End If
End Sub

 

[cenkataseven]

Sayfanın kod penceresine aşağıdaki kodları yapıştırınız.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [A5,A17,A55]) Is Nothing Then
    Target.Offset(1, 0).Select
    ActiveWindow.FreezePanes = True
End If
End Sub

Merhaba,

Çok teşekkür ederim. Ben de bir yandan "bir amatör" olarak internetten kod aparta aparta şu aşağıdakini yazmıştım. Sizinki çok daha temiz olmuş. Benim gibi arkadaşların karşılaştırıp daha kısa kod yazma mantığını anlamaları için ekliyorum. Ayrıca çift tıklayıp dondurma işlemi için de teşekkür ederim.

Option Explicit
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rng As Range
    Set rng = Range("A3,A10,A17")
    If Selection.Count = 1 Then
        If Not Intersect(Target, rng) Is Nothing Then
            ActiveWindow.FreezePanes = False
            Selection.Offset(1, 0).Select
            ActiveWindow.FreezePanes = True
        End If
    End If
End Sub

 

[cenkataseven]

Sayfanın kod penceresine aşağıdaki kodları yapıştırınız.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [A5,A17,A55]) Is Nothing Then
    [COLOR="Red"]ActiveWindow.FreezePanes = False [/COLOR]   
    Target.Offset(1, 0).Select
    ActiveWindow.FreezePanes = True
End If
End Sub

Sanırım sizin koda kırmızı satırı eklemek gerekecek. Çok teşekkürler tekrar.

 

[antonio]

Cevap beklerken, bir yandan da araştırma yapmanız size çok olumlu katkı sunacaktır. Kodlarınız gayet iyi. Gereksiz bir fazlalık veya kod uzatma yok.

 

[hopehope55]

kodu çalıştıramadım.