kenarlık ekleme

[mcetinkaya65]

a6 hücresinden sonra a sütununda herhangi bir hücreye bilgi girişi yapınca m sütununa kadar kenarlık çiziyor. Âmâ birkaç satır atlayıp da a sütununa bilgi girişi yaparsak atlanan hücrelere kenarlık çizmiyor. Örnek a6 ya değil de a15 ilk bilgi yazdığımızda üstünde kalan hücrelerde kenarlık çizmesi, hücrelerdeki başka formülleri değiştirmeden mümkün mü?
Selamlar...

 

[hamitcan]

Ben de doğru çalıştı.

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz? Tüm kodları ilgili sayfanın kod bölümüne kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target.Row < 7 Then Exit Sub
    If Target.Text <> "" Then Kenarlık_Çiz Range("A7:M" & Target.Row)
End Sub

Sub Kenarlık_Çiz(Alan As Range)
 
    Alan.Borders(xlDiagonalDown).LineStyle = xlNone
    Alan.Borders(xlDiagonalUp).LineStyle = xlNone
    With Alan.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Alan.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Alan.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Alan.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Alan.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Alan.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

End Sub

 

[mcetinkaya65]

İlminize ve bilginize Allah noksanlık vermesin.Yalnız son hücreden itibaren,verileri silinen hücrelerin kenarlıklarının da ,silinmesi mümkün mü ?Teşekkürler

 

[Necdet]

İlminize ve bilginize Allah noksanlık vermesin.Yalnız son hücreden itibaren,verileri silinen hücrelerin kenarlıklarının da ,silinmesi mümkün mü ?Teşekkürler

Sorunuzu anlamadım.

 

[mcetinkaya65]

Kenarlık ekleme işinin tam tersi.A hücresine veri girildikçe kenarlık ekliyor,A hücresinden veri silindikçe kenarlıkların da temizlenmesi
teşekkürler

 

[Necdet]

Merhaba,

A sütunundaki değeri tek tek sildiğinde çalışır.

Kenarlıkları ekleyen ve silen kodları modül içine aldım. Gerekirse bu kodları başka dosyalarda da kullanabilirsiniz diye.
Kenarlık silen kodda en alt satırdaki bilginin silineceği düşünülerek düzenlendi.

Aşağıdaki kod ilgili sayfanın kod bölümünde olmalı

Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target.Row < 7 Then Exit Sub
    If Target.Text <> "" Then
        Kenarlık_Çiz Range("A7:M" & Target.Row)
    Else
        Kenarlık_Sil Range("A" & Target.Row & ":M" & Target.Row)
    End If
    
End Sub

Aşağıdaki kodlarda bir modülün içine kopyalayınız.

Sub Kenarlık_Sil(Alan As Range)
 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Alan.Borders(xlEdgeBottom).LineStyle = xlNone
    Alan.Borders(xlDiagonalUp).LineStyle = xlNone
    Alan.Borders(xlEdgeLeft).LineStyle = xlNone
    Alan.Borders(xlEdgeRight).LineStyle = xlNone
    Alan.Borders(xlInsideVertical).LineStyle = xlNone
    Alan.Borders(xlInsideHorizontal).LineStyle = xlNone
    
End Sub

Sub Kenarlık_Çiz(Alan As Range)
 
    Alan.Borders(xlDiagonalDown).LineStyle = xlNone
    Alan.Borders(xlDiagonalUp).LineStyle = xlNone
    With Alan.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Alan.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Alan.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Alan.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Alan.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Alan.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
End Sub

 

[mcetinkaya65]

Zahmet verdik.Çok teşekkürler.