Macro ile dolu hücrelere kenarlık çizdirmek istiyorum

[millis]

Arkadaşlar, Hücreye Koşullu biçimlendirme ile kenarlık yapıldığını biliyorum, forum içerisinde arama yaptığımda da sadece koşullu biçimlendirme ile kenarlık konuları buldum ama benim istediğim Userformdan veri girdiğimde verinin ait olduğu hücreye karakter yazıldıktan sonra Örnek ( A dan M ye kadar olan hücrelere kenarlık koymasını ve bunu da Userformda Kaydet butonuna bastıktan sonra macro ile yapmasını istiyorum. Bu mümkün mü? Yardımcı olacak arkadaşlara şimdiden teşekkür eder, saygılarımı sunarım.

 

[xxcell]

Aşağıdaki kodları kendinize uyarlayınız.

KENARLIK_CIZILECEK_SATIR_NO = 14
        Set secim = Range("A" & KENARLIK_CIZILECEK_SATIR_NO & ":M" & KENARLIK_CIZILECEK_SATIR_NO).Borders
        secim(xlDiagonalDown).LineStyle = xlNone
        secim(xlDiagonalUp).LineStyle = xlNone
        secim(xlEdgeLeft).LineStyle = xlContinuous
        secim(xlEdgeLeft).Weight = xlThin
        secim(xlEdgeLeft).ColorIndex = xlAutomatic
        secim(xlEdgeTop).LineStyle = xlContinuous
        secim(xlEdgeTop).Weight = xlThin
        secim(xlEdgeTop).ColorIndex = xlAutomatic
        secim(xlEdgeBottom).LineStyle = xlContinuous
        secim(xlEdgeBottom).Weight = xlThin
        secim(xlEdgeBottom).ColorIndex = xlAutomatic
        secim(xlEdgeRight).LineStyle = xlContinuous
        secim(xlEdgeRight).Weight = xlThin
        secim(xlEdgeRight).ColorIndex = xlAutomatic
        secim(xlInsideVertical).LineStyle = xlContinuous
        secim(xlInsideVertical).Weight = xlThin
        secim(xlInsideVertical).ColorIndex = xlAutomatic

 

[millis]

Aslında sorum şu şekil.

İlginize teşekkür ederim. Benim istediğim örnek dosyadan da görüleceği gibi A6 hücresi ve aşağı doğru sonrası dolu oldğunda A sütunundan M sütununa kadar olan kısıma kenarlık çizmesi. Bu A sütununa veri girdikçe devam edecek. Örnek; A6 hücresine ilk kayıt yapıldığında; yani sıra numarasına 1 yazdığında A6 dan M6 ya kadar kenarlık çızmesi, daha sonraki kayıtda sıra no 2 olduğunda A7 den M7 ye kadar kenarlık çizilmesi. Anlatmak istediğim her kayıt yapıldığında bu şekil devam edecek.

 

[millis]

Pardon dosyayı göndermedim

Deminki yazıma istinaden göndereceğim dosya ekdedir.

 

[xxcell]

Aşağıdaki kodu ilgili sayfaya ekleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a6 :a65536]) Is Nothing Then Exit Sub
If Target.Text <> "" Then

KENARLIK_CIZILECEK_SATIR_NO = Target.Row
Set secim = Range("A" & KENARLIK_CIZILECEK_SATIR_NO & ":M" & KENARLIK_CIZILECEK_SATIR_NO).Borders
secim(xlDiagonalDown).LineStyle = xlNone
secim(xlDiagonalUp).LineStyle = xlNone
secim(xlEdgeLeft).LineStyle = xlContinuous
secim(xlEdgeLeft).Weight = xlThin
secim(xlEdgeLeft).ColorIndex = xlAutomatic
secim(xlEdgeTop).LineStyle = xlContinuous
secim(xlEdgeTop).Weight = xlThin
secim(xlEdgeTop).ColorIndex = xlAutomatic
secim(xlEdgeBottom).LineStyle = xlContinuous
secim(xlEdgeBottom).Weight = xlThin
secim(xlEdgeBottom).ColorIndex = xlAutomatic
secim(xlEdgeRight).LineStyle = xlContinuous
secim(xlEdgeRight).Weight = xlThin
secim(xlEdgeRight).ColorIndex = xlAutomatic
secim(xlInsideVertical).LineStyle = xlContinuous
secim(xlInsideVertical).Weight = xlThin
secim(xlInsideVertical).ColorIndex = xlAutomatic
End If
End Sub

 

[millis]

Teşekkür ederim

Xxcell çok teşekkür ederim, eline ve bilgine sağlık. Saygılarımı sunarım.

 

[mcetinkaya65]

makro ile kenarlık

a6 hücresinden sonra a stünunda herhangi bir hücreye bilgi girişi yapınca m stünuna kadar kenarlık çiziyor.Ama birkaç satır atlayıp da a sütünuna bilgi girişi yaparsak atlanan hücrelere kenarlık çizmiyor.Örnek a6 ya değilde a15 ilk bilgi yazdığımızda üstünde kalan hücrelerede kenarlık çizmesi mümkün mü?
Selamlar...