Sıra ile kayıtta otomatik kenar ekleme

[muratkarakas69]

Öncelikle iyi günler diliyorum. Sorum şu ;

Private Sub CommandButton47_Click()
Sheets("Sayfa23").Select
Range("a12").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("a12").Value = "" Then
Range("a12").Value = 1
Range("a12").Select
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If
ActiveCell.Offset(0, 1).Value = TextBox49.Text
ActiveCell.Offset(0, 2).Value = Textbox6.Text
ActiveCell.Offset(0, 3).Value = Textbox5.Text
ActiveCell.Offset(0, 4).Value = TextBox250.Text
End Sub



her veri eklendiğinde eklenen satırda A:AC sutunlarına otomatik hücre kenarlığı eklesin. Yardımınız için şimdiden teşekkürler

 

[Korhan Ayhan]

Merhaba,

Kayıt kodlarınızın bitimine aşağıdaki satırı ekleyin.

ActiveCell.Resize(1, 29).Borders.LineStyle = 1

Not: Kayıt işlemi için kullandığınız ilk boş satır bulma kodu çok işlevsel değildir. Veri sayınız arttıkça kodunuzda yavaşlama yaşarsınız.

 

[muratkarakas69]

İlginiz için teşekkürler . Kayıt işlemi için önereceğiniz bir kod var mı?

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kod yapısını kullanabilirsiniz. Daha hızlı sonuç verir.

Private Sub CommandButton47_Click()
    Dim Satır As Long
    
    With Sheets("Sayfa23")
        If .Range("A12") = "" Then
            .Range("A12") = 1
            Satır = 12
        Else
            Satır = .Cells(Rows.Count, 1).End(3).Row + 1
            .Cells(Satır, 1) = Cells(Satır - 1, 1) + 1
        End If
        
        .Cells(Satır, 2) = TextBox49.Text
        .Cells(Satır, 3) = TextBox6.Text
        .Cells(Satır, 4) = TextBox5.Text
        .Cells(Satır, 5) = TextBox250.Text
        .Cells(Satır, 1).Resize(1, 29).Borders.LineStyle = 1
    End With
 
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub

 

[muratkarakas69]

Teşekkürler çok sağolun elinize sağlık