Koşullu olarak Sayfalardan Print Almak

[taseraydin]

Gereklİ (İŞlem GÖren)sayfalardan Print Almak

Öncelikle Tüm Türk ve islam aleminin başta olmak üzere bütün formdaki arkadaşların Mübarek Ramazan Bayramını Candan kutlarım.

Bir Tablo Hazırladığım tablodan 20 sayfa aynı hücreleri değeler almakta belirtilen adresteki hücrelerine değer alan sayfaların yazdırma makrosuna ihtiyaç duymaktayım Örnek dosyayı ekte gönderiyorum arkadaşlardan yardım bekliyorum
Saygılar,Sevgiler

 

[taseraydin]

Sayfalardan Print Almak

a1 hücresinde değer olan Sayfalardan Print Alma macrosu

 

[AS3434]

Sayın taseraydin

Aynı konu ile ilgili lütfen yeni başlıklar açmayın. (Mesajlar birleştirilmiştir.)

Aşağıdaki Kodları bir butona bağlayın.

Sub kaydetyazdır()
Set lst = Sheets("LIST")
Set thk = Sheets("TAHAKKUK")
For x = 9 To 18
If Not Cells(x, 1) = "" Then
a = thk.[a65536].End(3).Row + 1
lst.Rows(x).Copy
thk.Rows(a).PasteSpecial Paste:=xlPasteValues
End If
Next x
Application.CutCopyMode = False
thk.Select
For i = 3 To [a65536].End(3).Row
If Not thk.Cells(i, 2) = "" Then
sıra = sıra + 1
thk.Cells(i, 1) = sıra
End If
Next i
For t = 3 To Sheets.Count
If Sheets(t).[c14] = Empty And Sheets(t).[c20] <> Empty Then Sheets(t).[COLOR=red]PrintPreview[/COLOR] [COLOR=seagreen]'PrintOut[/COLOR]
If Sheets(t).[c14] <> Empty And Sheets(t).[c20] = Empty Then Sheets(t).[COLOR=red]PrintPreview[/COLOR] [COLOR=seagreen]'PrintOut[/COLOR]
Next t
lst.Select
End Sub

Yazdırmak için kodlarda ki kırmızı kısmı (Printpreview) , yeşil (Printout) ile değiştirin.

Dosyayı inceleyin.

NOT : KODLARDAKİ HATA NEDENİYLE TÜM SAYFALAR YAZDIRILIYORDU. DOSYA YENİLENMİŞTİR.

 

[taseraydin]

Bİraz Daha SadeleŞtİrebİlİrmİyİz

Yazilmasi Gereken Sayfalarin Tamamina A1 Hücresinde değer olan sayfaların yazdırılması
Buna GÖre Daha Basİr Bİr Makroyu DÜzenleyebİlİrmİsİnİz,
Yazdirma İŞlemİnİ Sayfa GÖrÜntÜsÜz Dİrek Yazdirmasi MÜmkÜnmÜ

Lİst Sayfasindan Tahakkuk Sayfasina İstedİĞİm Gİbİ Verİlerİ Aktariyor
Burda Bİr Tek Sorun Dosya Numarasi Ve GÖrev Yapilan Kurum İkİsİ Bİrden Daha Önce Tahakkuk Sayfasina Kayitli İse Tablodakİ O Satir Kayit Yapilmasisi Ve Bİr Uyari Versİn.
İlgİnİze TeŞekÜr Ederİm.
Sevgİler Saygilar

 

[taseraydin]

KoŞullu Sayfa Yazdirma Makrosu

Excel Dosyamda
1,g1-2,g2....10,g10 İsİmlİ 20 Adet Sayfam Var
Yazdirilmasi Gereken Sayfalarin A1 HÜcresİne Bİr Metİn Gelİyor

A1 HÜcresİnde Metİn DeĞerİ Alinan Sayfalarin Tamaminin Yazilmasi İÇİn Bİr Macro Ya İhtİyacim Var

DeĞerlİ Üstadlarin Yardimldrini Beklİyorum
Saygilar,sevgİler

 

[Orion1]

Merhaba.
Aşağıdaki kodları denermisiniz.
A1:G20 aralığını yazdırıyor.

Sub yazdir()
Dim syf As Worksheet
For Each syf In Worksheets
    If syf.Range("A1").Value <> "" Then
        Sheets(syf.Name).PageSetup.PrintArea = syf.Name & "!$A$1:$G20"
        syf.PrintOut Copies:=1
    End If
Next
End Sub

 

[AS3434]

Sayın taseraydin

Niçin ısrarla aynı soru için yeni başlık açıyorsunuz.

Sorunuzun cevabı zaten yukardaki makroda var.

For t = 3 To Sheets.Count
If Sheets(t).[c14] = Empty And Sheets(t).[c20] <> Empty Then Sheets(t).PrintPreview 'PrintOut
If Sheets(t).[c14] <> Empty And Sheets(t).[c20] = Empty Then Sheets(t).PrintPreview 'PrintOut
Next t
lst.Select
End Sub

Düzenlersek:

sub yazdır()
For t = 3 To Sheets.Count
If Sheets(t).[a1] <> Empty Then Sheets(t).PrintOut
Next t
End Sub

 

[taseraydin]

TeŞekÜr

Değerli
orion2 , AS3434 ve
diğer üstad arkadaşlar forumda gösterdiğiniz ilgi ve yardımdımlarınızdan dolayı içten teşekür ederim
zaman zaman proğramdaki acemiliğimizi form kurallarında da yapıyoruz ..
yardımlarınız la birlikte Hoşgörünüzede ihtiyacımız var
Tekrar tekrar teşekür ederim .