işaretli olan CheckBox'ların satırındaki bilgileri sayfa2'ye aktar ve çıktı al?

[abcd_efe]

merhaba arkadaşlar.
excel dosyasında giriş ve form isimli 2 sayfa var. giriş isimli sayfada checkbox'lar var. bu checkbox'lardan hangisi veya hangileri işaretli işaretli olan checkbox'un satırında bulunan bilgileri form isimli sayfadaki ilgili yerlere yazacak ve yazıcıdan çıktı alacak. birinci işaretli checkbox bilgileri form isimli sayfaya aktarılıp yazıcıdan yazdırıldıktan sonra ikinci checxbox'taki bilgiler yine form isimli sayfadaki ilgili yerlere (önceki bilgiler silinerek) yazılıp yine çıktı alınacak. yardımcı olursanız sevinirim. şimdiden teşekkür ederim. iyi çalışmalar. (dosya ekte)

 

[Orion1]

Dosyanız ekte.

Private Sub CommandButton1_Click()
Dim cb As OLEObject, sat As Byte, kontrol As Boolean
For Each cb In Sheets("giriş").OLEObjects
    If TypeName(cb.Object) = "CheckBox" Then
        If cb.Object.Value = True Then
            sat = Right(cb.Name, Len(cb.Name) - 8)
            Sheets("form").Range("B4,G13,C11").Clear
            Sheets("form").Range("B4").Value = Cells(sat, "E").Value
            Sheets("form").Range("G13").Value = Cells(sat, "F").Value
            Sheets("form").Range("C11").Value = Cells(sat, "G").Value
            Sheets("form").Range("B4").EntireRow.Interior.Color = vbRed
            Sheets("form").Range("G13").EntireRow.Interior.Color = vbRed
            Sheets("form").Range("C11").EntireRow.Interior.Color = vbRed
            Sheets("form").Range("B4").EntireRow.Font.Color = vbWhite
            Sheets("form").Range("G13").EntireRow.Font.Color = vbWhite
            Sheets("form").Range("C11").EntireRow.Font.Color = vbWhite
            Sheets("form").PageSetup.PrintArea = "form!$B$4:$G13"
            Sheets("form").PrintOut
            kontrol = True
        End If
    End If
Next cb
If kontrol = True Then
    MsgBox "İşlem tamam"
    Else
    MsgBox "En az bir çekbox'ı işaretlemilisiniz..!!", vbCritical, "UYARI"
End If
End Sub

Private Sub CommandButton2_Click()
Dim cb As OLEObject
For Each cb In Sheets("giriş").OLEObjects
    If TypeName(cb.Object) = "CheckBox" Then cb.Object.Value = True
Next
End Sub

Private Sub CommandButton3_Click()
Dim cb As OLEObject
For Each cb In Sheets("giriş").OLEObjects
    If TypeName(cb.Object) = "CheckBox" Then cb.Object.Value = False
Next
End Sub

 

[abcd_efe]

teşekkür ederim. checkboxlardan hiçbiri işaretli değilse birini seç gibi bir mesaj nasıl verdiriliyor acaba? bir de checkboxu seçili olan satırların renklenmesini ve hepsini seç hiçbirini seçme butonlarıyla checkboxların hepsinin seçilebilmesini veya işaretlerin kalkmasını istiyorum ama?

 

[abcd_efe]

arkadaşlar checkboxlardan hiçbiri işaretli değilse birini seç gibi bir mesaj nasıl verdiriliyor acaba? bir de checkboxu seçili olan satırların renklenmesini ve hepsini seç hiçbirini seçme butonlarıyla checkboxların hepsinin seçilebilmesini veya işaretlerin kalkmasını istiyorum ama?

 

[Orion1]

arkadaşlar checkboxlardan hiçbiri işaretli değilse birini seç gibi bir mesaj nasıl verdiriliyor acaba? bir de checkboxu seçili olan satırların renklenmesini ve hepsini seç hiçbirini seçme butonlarıyla checkboxların hepsinin seçilebilmesini veya işaretlerin kalkmasını istiyorum ama?

Dosyayı düzenledim.
2 numaralı mesajdan indirebilirsiniz.

 

[eminuslu]

Chk

Merhaba Sayın gizlen yapmış olduğunuz bu çalışma ile bizlere yardımcı olduğunuz için size teşekkür ederim
Ancak programda seçilen chexbo.taki bilgileri yatay olarak sayfa2 ye aktarıp eğer yazılması gerekiyorsa aktarılan sayfadan yazdırmak istiyorum bunu nasıl yapabiliriz bu konuda bir değişiklik yapıp aydınlatmanız konusunda teşekkür ederim

 

[Orion1]

Merhaba Sayın gizlen yapmış olduğunuz bu çalışma ile bizlere yardımcı olduğunuz için size teşekkür ederim
Ancak programda seçilen chexbo.taki bilgileri yatay olarak sayfa2 ye aktarıp eğer yazılması gerekiyorsa aktarılan sayfadan yazdırmak istiyorum bunu nasıl yapabiliriz bu konuda bir değişiklik yapıp aydınlatmanız konusunda teşekkür ederim

Dosyayı istediğiniz şekilde düzenledim.

Private Sub CommandButton1_Click()
Dim cb As OLEObject, sat As Byte, kontrol As Boolean
Sheets("form").Range("B1:D5").ClearContents
For Each cb In Sheets("giriş").OLEObjects
    If TypeName(cb.Object) = "CheckBox" Then
        If cb.Object.Value = True Then
            For i = 1 To 5
                If cb.Object.Caption = Sheets("form").Cells(i, "A").Value Then
                    sat = Right(cb.Name, Len(cb.Name) - 8)
                    Sheets("form").Cells(i, "B").Value = Cells(sat, "E").Value
                    Sheets("form").Cells(i, "C").Value = Cells(sat, "F").Value
                    Sheets("form").Cells(i, "D").Value = Cells(sat, "G").Value
                End If
            Next i
            kontrol = True
        End If
    End If
Next cb
If kontrol = True Then
    Sheets("form").Select
    MsgBox "İşlem tamam"
    Else
    MsgBox "En az bir çekbox'ı işaretlemilisiniz..!!", vbCritical, "UYARI"
End If
End Sub

 

[eminuslu]

Chk**

Sayın gizlen bizlerin soru ve sorunlarıyla ilgilendiğiniz için size ne kadar teşekkür etsem azdır çalışma benim istediğim şekilde olmamış ben soruyu anlatamadığım için sizin dosyayı kendi istediğim şekilde size gönderiyorum bu konuda yardımcı olmanız dileğimle hoşca kalın istek dosyam ektedir

 

[Orion1]

Sayın gizlen bizlerin soru ve sorunlarıyla ilgilendiğiniz için size ne kadar teşekkür etsem azdır çalışma benim istediğim şekilde olmamış ben soruyu anlatamadığım için sizin dosyayı kendi istediğim şekilde size gönderiyorum bu konuda yardımcı olmanız dileğimle hoşca kalın istek dosyam ektedir

Ama şimdi bu yapılırmı.
Niye daha önce dosyanızı yollamadınız.
Hep diyorum kendime sorusu net olmayan sorulara cevap yazmayacam diye yine yazıyorum işte.
Dosyanız ekte.

Private Sub CommandButton1_Click()
Dim cb As OLEObject, sat As Byte, kontrol As Boolean, sat2 As Long
sat2 = Sheets("form").Cells(65536, "A").End(xlUp).Row + 1
For Each cb In Sheets("giriş").OLEObjects
    If TypeName(cb.Object) = "CheckBox" Then
        If cb.Object.Value = True Then
            sat = Right(cb.Name, Len(cb.Name) - 8)
            Sheets("form").Cells(sat2, "A").Value = Cells(sat, "E").Value
            Sheets("form").Cells(sat2, "B").Value = Cells(sat, "F").Value
            Sheets("form").Cells(sat2, "C").Value = Cells(sat, "G").Value
            Sheets("form").Cells(sat2, "D").Value = Cells(sat, "H").Value
            Sheets("form").Cells(sat2, "E").Value = Cells(sat, "I").Value
            kontrol = True
            sat2 = sat2 + 1
        End If
    End If
Next cb
If kontrol = True Then
    Sheets("form").Select
    MsgBox "İşlem tamam"
    Else
    MsgBox "En az bir çekbox'ı işaretlemilisiniz..!!", vbCritical, "UYARI"
End If
End Sub

 

[eminuslu]

Chk**

Sayın gizlen sorumu tam ifade edemeyip sizi üzdüğüm için sizden özür diliyorum belki benim gibi acemilere sitem etmekte haklısın ama bizler bu sitede sizler sayesinde birşeyler öğreniyoruz onun içinde neyi nasıl soracağımız konusunu bilemiyoruz kendi adıma konuşuyorum çoğumuz ileri yaşta sonradan bilgisayarla tanışıp ilgi duyan kimseleriz şahsen benim tevellüt 1962 ama sizden küçükte olsam büyükte olsam bile size verdiğim rahatsızlıktan dolayı özür dilerim ama verdiğiniz cevap tam istediğim şekilde olmuş onun içinde ayrıca teşekkür ederim bu mübarek gecede beni sevindirdiniz kandiliniz mübarek olsun

 

[Orion1]

Estafurullah.
İyi çalışmalr.