validate list'le oluşacak sayfaları bir kerede yazdırma

[peleryn]

Herkese Merhabalar;

Bir hücreye veri doğrulama ile atadığım bir liste var.Bu listedeki tüm öğeleri sırayla seçerek her seçimimde sayfada oluşan değişikliklere bağlı olarak yeni bir sayfayı yazdır'a basarak yazdırıyorum.Dosyanın içinde de açıklama yaptım ancak burada da belirteyim.Acaba diyorum bir butonla bir döngü sağlayıp listedeki tüm öğeler sırayla seçilebilir ve her seçimde oluşacak olan sayfa bu esnada otomatik olarak yazdırılabilir mi?

İlgilenecek olanlara teşekkür ederim.Sadece listenin hazırlandığı hücrenin bulunduğu basit bir örnek dosya ektedir.

 

[Ömer]

Merhaba,

Listedeki veriler çalışma dosyasında sayfa olarak var ve tüm bu sayfaları buton ile tek seferdemi yazdırmak istiyorsunuz.

.

 

[peleryn]

Merhaba,

Listedeki veriler çalışma dosyasında sayfa olarak var ve tüm bu sayfaları buton ile tek seferdemi yazdırmak istiyorsunuz.

.

Ömer Hocam Merhaba;

O şekilde değil hocam.listedeki verilerden diyelim ayşeyi seçince ana dosyada ayşenin tc kimlik nosu adresi vs başka bir sayfadan bu sayfaya çekiliyor.listeden her yeni isim seçtiğimde haliyle bu sayfadaki veriler değişiyor ve ben listedeki her isme ait bilgileri yazdırmak için listeden her seferinde yeni bir isim seçip yazdır butonuna basıyorum.İşte bu noktada oluşturmuş olduğum veri doğrulama listesini döngüye sokacak ve ilk verisinden son verisine kadar sırayla seçip her değiştiğinde sayfayı yazdıracak bir buton yapılabilir mi diyorum.Umarım daha net aktarabilmişimdir..

 

[peleryn]

Her değiştiğinde sayfayı yazdırmayı arşivden faydalanarak yapabilirim.ancak arşivde validatelist'i döngüye sokacak bir kod yapısına malesef kendi aramalarımla ulaşamadım..

 

[Korhan Ayhan]

Selamlar,

Bu işlem için kaynak listeyi döngüye alıp yazdırma işleminizi yaptırabilirsiniz.

Option Explicit
 
Sub SEÇ_YAZDIR()
    Dim Hücre As Range
    
    For Each Hücre In Range("isim")
        With Sheets("Sayfa2")
            .Range("C4").Value = Hücre.Value
            .PrintOut
        End With
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[peleryn]

Korhan Hocam teşekkür ederim sorunum halloldu.Kodlar ilk etapta çalışmadı.Kırmızı ile gösterdiğim şekilde bir eklemeyle çalıştı.

Private Sub CommandButton1_Click()
Dim Hücre As Range

For Each Hücre In Sheets("Sayfa1").Range("isim")
With Sheets("Sayfa2")
.Range("C4").Value = Hücre.Value
.PrintOut
End With
Next

MsgBox "İşleminiz tamamlanmıştır.", vbInformation

End Sub

 

[peleryn]

Bu arada kendim de bulduğum örneklerden hareketle son haliyle şöyle bir kod oluşturdum.Bu da aynı şekilde çalışıyor.İlgilenecek olanlar olursa diye veriyorum.

Private Sub CommandButton1_Click()
Dim yeniliste As New Collection
On Error Resume Next
For Each ce In Sheets("Sayfa1").Range("isim")
yeniliste.Add Item:=ce.Value, key:=ce.Value
Next ce
On Error GoTo 0
For i = 1 To yeniliste.Count
Sheets("Sayfa2").Range("c4").Value = yeniliste(i)
Sheets("Sayfa2").PrintOut
Next i
MsgBox "İşlem Tamam"
End Sub