Buton İle Eğer Hücre Dolu İse Hücrelere Kenarlık Çizme( VBA Kodu)

[Sarigol_937]

Merhaba arkadaşlar Excel Tablomuzda; "A1"' Sütunundan "AD400"' sütununu, kapsayacak şekilde, Excel çalışma sayfasına eklediğimiz "Buton" ile birleştirilmiş hücreleride kapsayacak biçimde, Kenarlık rengi siyah, Hücreden veri silinince kenarlık varsa "Butona" basınca, tüm hücre dolu olan olan hücrelere kenarlık oluşturması, hücre içeriğiden veri silinen hücrelerin kenarlığınında silinmesini sağlayan, bir VBA koduna ihtiyacım var.Yardımcı olan arkadaşlara teşekkür ederim.
Forumda paylaşılan diğer tüm kenarlıkla ilgili VBA kodlarını inceledim, Worksheetchange olayına eklenmiş çoğusu ve bu nedenle kasma ,vba kodlarında çakışmaya hataya sebep oluyor, Bazıları ise satır ekliyor hücre doluysa ancak hücredeki veriyi silince hücre kenarlığını silmiyor vb. problemleri var.

 

[turist]

Koşullu biçimlendirme ile istediğinizi sağlayabilirsiniz.

 

[yasinbilgi]

Private Sub CommandButton1_Click()
Dim wsAnaSayfa As Worksheet
Dim wsNewPage As Worksheet
Dim newPageName As String
Dim index As Integer

Set wsAnaSayfa = Worksheets("Sayfa1")

newPageName = CStr(wsAnaSayfa.Range("B1").Value)


Sheets.Add(After:=Sheets(Sheets.Count)).Name = newPageName
Set wsNewPage = Worksheets(newPageName)
wsNewPage.Columns("A").ColumnWidth = 50
wsNewPage.Columns("B").ColumnWidth = 9
index = 1
For i = 1 To wsAnaSayfa.UsedRange.Rows.Count
If wsAnaSayfa.Range("P" & i).Value <> "" Then
wsNewPage.Range("A" & index).Value = wsAnaSayfa.Range("B" & i).Value
wsNewPage.Range("B" & index).Value = wsAnaSayfa.Range("P" & i).Value
index = index + 1
End If

Next i

End Sub
bu kodun neresine nasıl kod eklersem oluşturulan dolu hücrelere kenarlık ekler

 

[Ömer BARAN]

Merhaba.
Yanlış anlamadıysam aşağıdaki satırı, " index = index + 1 " satırının üstüne ekleyerek sonuç almanız lazım.

wsNewPage.Range("A" & index).Borders.LineStyle = xlContinuous
wsNewPage.Range("B" & index).Borders.LineStyle = xlContinuous