Seçili olanları yazdır

[meleklerim]

ekte örneğini gönderdiğim
1) tablodan K5 başvuru hücresine göre "düşeyara" ile oluşturduğum işçi kartının H sütununda onay kutusu işaretlenen işçileri bilgileri ile sırayla yazdırmasını istiyorum. (Yazdır dendiğinde sadece işçi kartı yazdırılacak şekilde yazdırma alanı belirledim)
Oluşturulacak kod örneğin 1 ve 3 nolu işçiler işaretli ise k5 hücresine önce 1 yazıp yazdırmasını sonra 3 yazıp yazdırmasını istiyorum.
2) Bir de tümünü seç/ temizle butonu eklenirse harika olur ama olmazsa olmaz değil
Yardımcı olacak arkadaşlara şimdiden teşekkürler
(Ofis 2013 plus 32 bit kullanıyorum)

 

[meleklerim]

galiba çok zor birşey ya da herkes çok meşgul. Yardımcı olabilir mi acaba diye buna benzer eski kullandığım ve kendime göre uyarladığım bir makroyu aşağıya ekliyorum. Bu makro am2 hücresinde yazılı olan sayıdan başlayıp am3 hücresine kadar olan sayıya kadar sayıları ak6 hücresine teker teker getirip yazdırıyor. bunu artık kullanamıyorum çünkü am2 ye 1, am3 e 4 yazdığımda 1,2,3,4 nolu işçileri yazırıyor. sanırım (i+1 fonksiyonu yüzünden) halbuki ben 1 ve 4 yazdığımda sadece 1 ve 4 ün yazdırılmasını istiyorum. Yeniden kod yazmak mevcut kodu uyarlamaktan daha kolay olduğunu düşünmüştüm ama olmadı. Tekrar yardımcı olacak arkadaşlara şimdiden teşekkür ederim

Sub yazdırISCIKARTI()

Dim i As Integer, _
c As Range, _
Shi As Worksheet

Set Shi = Sheets("İşçi Kartı")

If IsNumeric(Range("Am2")) = True And IsNumeric(Range("Am3")) = True Then

For i = Range("Am2") To Range("Am3")

Range("Ak6") = Shi.Range("At" & i + 1)
Sheets("İşçi Kartı").PrintOut

 

[meleklerim]

son bir not: Bugün benim doğum günüm

 

[AdemCan]

Merhaba, doğum gününüz kutlu olsun

CheckBox VBA Döngü isimli konudan faydalanarak bir örnek hazırladım.

Ancak bu örnek için sayfadaki CheckBox ları ActiveX Denetimleri kısmından eklemelisiniz.




CheckBox ları ekledikten sonra aşağıdaki kodları kullanabilirsiniz.

Sub secili_olani_yazdir()

Dim nesne As Object, i As Byte

For Each nesne In ActiveSheet.OLEObjects
    For i = 1 To 6
        If nesne.Name = "CheckBox" & i And nesne.Object = True Then
           Range("K5") = nesne.Object.Caption
           Sayfa1.PrintOut
        End If
    Next
Next
End Sub

Sub tumunu_sec()

Dim nesne As Object
CheckBox8.Value = False
For Each nesne In ActiveSheet.OLEObjects

If nesne.Name = "CheckBox7" Or nesne.Name = "CheckBox8" Then GoTo gec

If nesne.Name Like "CheckBox" & "*" Then
    nesne.Object = True
End If
gec:
Next
End Sub
Sub tumu_iptal()

Dim nesne As Object

For Each nesne In ActiveSheet.OLEObjects

If nesne.Name = "CheckBox8" Then GoTo gec
If nesne.Name Like "CheckBox" & "*" Then
    nesne.Object = False
End If
gec:
Next
End Sub

Private Sub CheckBox7_Click()
If CheckBox7.Value = True Then tumunu_sec
End Sub

Private Sub CheckBox8_Click()
If CheckBox8.Value = True Then tumu_iptal
End Sub

 

[meleklerim]

eve gittiğimde deneyeceğim, teşekkürler

 

[meleklerim]

çok teşekkür ederim istediğim gibi çalışıyor, elinize sağlık @faye_efsane

 

[AdemCan]

Rica ederim.