Checkbox Ile Secilenleri Kopyala

Herkese merhabalar, sanirim asagidaki mail adreslerinin gercekte kullanilmadigini soyleyerek baslayabilirim 🙂 Bu konumuzda sayfadan sayfaya veri aktarma calismalarindan bir ornek cozecegiz. Ornegimiz yukaridaki resimlerde goruldugu uzere checkboxlarla yapilan secimleri aktarmamiza yariyor.

Bu tarz bir islem yapabilmek icin 3 ayri macro kullandik. Ekle, Sil ve Kopyala olarak kisaca yazabilirim. Simdi her birinde kullandigimiz kodlari paylasirken detyalandirmaya calisalim.

Checkboxlari Ekleme Makrosu

Sub checkbox_Ekle()
Dim Hucre, Son_Satir As Single
Dim Secim As checkbox
Dim Sol, Ust, Yukseklik, Genislik As Double
Application.ScreenUpdating = False
Son_Satir = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For Hucre = 2 To Son_Satir
If Cells(Hucre, "A").Value <> "" Then
Sol = Cells(Hucre, "E").Left
Ust = Cells(Hucre, "E").Top
Yukseklik = Cells(Hucre, "E").Height
Genislik = Cells(Hucre, "E").Width
ActiveSheet.CheckBoxes.Add(Sol, Ust, Genislik, Yukseklik).Select
With Selection
.Caption = ""
.Value = xlOff
.Display3DShading = False
End With
End If
Next Hucre
Application.ScreenUpdating = True
End Sub

Ekleme icin soyleyebilceklerim soldan ve ustten ekleyecegimiz hucrenin uzakliklarini alarak bir koordinat belirlemek zorunda oldugumuz, daha sonra eklenicek hucrenin genislik ve yuklekliginide alarak buraya checkbox ekleyebilecegimizdir..

Makromuzda ilk satirimizin 2`den baslayacagimizi bildigimizden son satiri buldurarak 2`den son satir sayisina kadar bir dongu olustururak, buldugumuz koordinat ve ozellukteki hucreye checkboxlarimizi bir dongu sayesinde ekliyoruz.

Checkboxlari Silme Makrosu

Sub Checkbox_Sil()
'Dim Secim As CheckBox
ActiveSheet.CheckBoxes.Delete
'For Each Secim In ActiveSheet.CheckBoxes
' Secim.Delete
'Next
End Sub

Silme makrosunda ilk etapta goreceginiz uzere bazi kodlari yourm haline getirdik. Bunun anlami o sekildede silme islemini yapabileceginizdir. Aciklanacak birsey yok sayfa uzerindeki silme islemi bu sekilde diyebilirim.

Isaretli Satirlari Kopyalama Makrosu

Sub Secilenleri_Kopyala()
For Each Secim In ActiveSheet.CheckBoxes
If Secim.Value = 1 Then
For say = 1 To Rows.Count
If Cells(say, 1).Top = Secim.Top Then
With Worksheets("Sayfa")
Son_Satir = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & Son_Satir & ":D" & Son_Satir) = _
Worksheets("data").Range("A" & say & ":D" & say).Value
End With
Exit For
End If
Next say
End If
Next
End Sub

Daha onceki degisken atamalarimizda secim atamasinin Dim Secim As checkbox seklinde oldugunu hatirlarsiniz yani Checkbox ekle makromuzda. Burada da tum ckecboxlarda islem yapacagimizi soyleyen bir kodumuz var fakat degerlerinin 1 olmasi sarti ile. Checkbox`in degerinin 1 olmasi o checkbox`in isaretli oldugunu gostermektedir..

Checkbox`imiz ile satirimizin ayni olmasi icin If Cells(say, 1).Top = Secim.Top Then ustten olan uzakliklari ile karsilastirarak dogru olanlari kopyalamayi sagliyoruz.

Daha sonra kopyalanacak sayfanin with ozelligini belirliyor ve Son satiri daima en son dolu satirdan 1 fazlasi olarak belirliyoruz. Bunun nedeni son dolu satirin uzerine yazdirmamak.

.Range(“A” & Son_Satir & “:D” & Son_Satir) = _

Worksheets(“data”).Range(“A” & say & “:D” & say).Value

sonra ustteki kodumuzdaki gibi (Kopyala makrosunun parcasi) “=” atamasi ile kopyalama islemini yapiyoruz.

Secilenleri Kopyala

Yazar: mmustafaaslan

2004 yilindan itibaren ozel bir sirketin finans departmaninda calismaktadir. Kendini excel, visual basic kullaniminda gelistirmis olan yazarimiz; Meslegi geregi SAP konusunda ileri derecede bilgilidir.

Bir Cevap Yazın

E-posta hesabınız yayımlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir


8 + 9 =