Onay kutusu ile sayfadan sayfaya veri tasima

[mustafaine1]

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Set s2 = Sheets("Payment")
Set s1 = Sheets("FORECAST")
    For i = 1 To s1.OLEObjects.Count - 1
        Set onay = s1.OLEObjects(i)
        If Left(onay.Name, 8) = "CheckBox" And onay.Object.Value = True Then
        satir = onay.BottomRightCell.Row
            s1.Range(Cells(satir, "B"), Cells(satir, "M")).Copy
            s2.Cells(s2.[b65536].End(3).Row + 1, "B").PasteSpecial Paste:=xlValues
            kopyalanan = kopyalanan & satir & Chr(10)
        End If
    Next
    Application.CutCopyMode = False
MsgBox "Aktarilan Satirlar Listesi" & Chr(10) & kopyalanan, vbInformation, "BILGI"
End Sub

arkadaslar buu sekilde bir kodum var sayfadan baska bir sayfaya checkbox`in true oldugu satirlari tasimak istiyorum, yardimci olurmusunuz ornek bir dosya ekledim, saygilar..

 

[halit3]

bu kod işinizi görür herhalde mesajın yerine kapyalıyacağınız kodları yazarsınız.

Private Sub CommandButton1_Click()
Dim Picture As Object
For Each Picture In ActiveSheet.Shapes
If TypeName(ActiveSheet.Shapes(Picture.Name).OLEFormat.Object) = "OLEObject" Then
If TypeName(ActiveSheet.Shapes(Picture.Name).OLEFormat.Object.Object) = "CheckBox" Then
If ActiveSheet.Shapes(Picture.Name).OLEFormat.Object.Object = True Then
MsgBox Picture.Name & " ", vbCritical, "U Y A R I"
End If
End If
End If
Next Picture
End Sub

Private Sub CommandButton1_Click()
Dim Picture As Object
For Each Picture In Sheets("Sayfa2").Shapes
If TypeName(Sheets("Sayfa2").Shapes(Picture.Name).OLEFormat.Object) = "OLEObject" Then
If TypeName(Sheets("Sayfa2").Shapes(Picture.Name).OLEFormat.Object.Object) = "CheckBox" Then
If Sheets("Sayfa2").Shapes(Picture.Name).OLEFormat.Object.Object = True Then
MsgBox Picture.Name & " ", vbCritical, "U Y A R I"
End If
End If
End If
Next Picture
End Sub

 

[mustafaine1]

tesekkurler halit bey dosyayı nasıl eklemeyi unuttum bilmiyorum suanda dosyada yanımda degıl yarın kodlarınızı kendıme gore editleyecegim sanırım ıse yarayacaktır gordugum kadarıyla tesekkur ederım..

 

[mustafaine1]

ben kendime gore uyarlayamadim ayrica tum kriterler gerceklesmiyor sanirim bu sekilde, dosyayi ekledim, inceleyen arkadaslara tesekkurler..

 

[mustafaine1]

konuyu cozume ulastirdim simdi soyle oluyoki benim ekledigimonay kutulari oleobject olarak sayilmiyor activex olan checkbox eklemem gerekiyormus yazdigim kodda boyle bir sayim problemi yasadigimi bugun farkettim, ilk dosyadan checkboxlari silip activex checkbox eklersek calisacak, saygilar..

 

[halit3]

dosyanı sabah görmediydim 4 nolu masajdaki dosyaya bu kodu denermisiniz

Private Sub CommandButton1_Click()
sat = 3
Set s2 = Sheets("Payment")
Set s1 = Sheets("FORECAST")
Dim Picture As Object
For Each Picture In s1.Shapes
i = i + 1
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object) = "CheckBox" Then
If s1.Shapes(Picture.Name).OLEFormat.Object = 1 Then
satir = Picture.BottomRightCell.Row
s1.Range(s1.Cells(satir, "B"), s1.Cells(satir, "M")).Copy
s2.Cells(sat, "B").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
sat = sat + 1
If s1.Shapes(Picture.Name).OLEFormat.Object = True Then
MsgBox Picture.Name & " ", vbCritical, "U Y A R I"
End If
End If
End If
Next Picture
End Sub

 

[mustafaine1]

Farklı cozumunuz ıcın cok tesekkur ederım Halıt bey, sızın cozumunuzu normal onak kutuları ıcınde denedım calısıyor, ılk mesajdakı cozumum actrıvex onaykutusu ıle calısıyor sadece OLEObjects.Count komutunu immediate penceresinde calistirinca farkettim bunu bu komutla kontrol onay kutularini sayamiyorsunuz 1 sonucunu veriyor butonu sayarak, buradaki ornekten cok daha komplike bi calisma olacagindan kodlariniz hem bu calisma icin hem bu konunun ogretisi icin cok iyi oldu tekrar tesekkurler..