Soru Kayıt ederken kenarlık yapma

[sirkülasyon]

Private Sub CommandButton2_Click()
If ListBox1.ListIndex = -1 Then: MsgBox "Kadrosunun bulunduğu listeden seçim yapılmadı!!!": ListBox1.SetFocus: Exit Sub
If ListBox2.ListIndex = -1 Then: MsgBox "Personel isim listesinden seçim yapılmadı!!!": ListBox2.SetFocus: Exit Sub
If ListBox3.ListIndex = -1 Then: MsgBox "Görevlendirilecek okul listesinden seçim yapılmadı!!!": ListBox3.SetFocus: Exit Sub
If ListBox4.ListIndex = -1 Then: MsgBox "Görevlendirilecek Branş listesinden seçim yapılmadı!!!": ListBox4.SetFocus: Exit Sub
Onay = MsgBox("Kaydetmek istiyor musunuz?", vbCritical + vbYesNo)
    If Onay = vbNo Then Exit Sub
For i = 1 To 10000
ProgressBar1 = i / 10000 * 100
Next
ProgressBar1.Value = Empty
son = Cells(65536, "a").End(xlUp).Row + 1
Sheets("Sayfa2").Cells(son, "B") = ListBox1.Value
Sheets("Sayfa2").Cells(son, "C") = ListBox2.Value
Sheets("Sayfa2").Cells(son, "D") = TextBox1.Text
Sheets("Sayfa2").Cells(son, "E") = TextBox2.Value
Sheets("Sayfa2").Cells(son, "F") = TextBox3.Value
Sheets("Sayfa2").Cells(son, "G") = TextBox4.Value
Sheets("Sayfa2").Cells(son, "H") = ListBox3.Value
Sheets("Sayfa2").Cells(son, "I") = ListBox4.Value
Sheets("Sayfa2").Cells(son, "J") = ComboBox1.Value
[a2:a65536] = Empty
deg = WorksheetFunction.CountA(Range("b2:b65536"))
s = 1
Do While [b2] <> ""
Cells(s + 1, "a") = s
s = s + 1
If s > deg Then Exit Do
Loop
Say = WorksheetFunction.CountA(Range("A3:A65500"))
    For i = 2 To Say
        Cells(i + 1, 1) = i
    Next i
MsgBox "KAYIT İŞLEMİ YAPILMIŞTIR.", vbInformation
Unload Me
End Sub

Rica etsem kayıt yaptığı an A : J aralığına kenarlık ekleme yapacak kodu ekleyebilir misiniz?

 

[Ömer]

Merhaba,

Kenarlık dan kastınızı tam olarak anlayamadım.
MsgBox satırından önce aşağıdaki kodları yazarak deneyiniz.

Range("A2:J" & Rows.Count).Borders.LineStyle = xlNone
Range("A2:J" & s).Borders.LineStyle = 1

.

 

[sirkülasyon]

Teşekkür ederim.
İstediğimi sağladı Ömer Abi