belli kurallara göre yazdırma

[mahmutozdemir]

Slm,
B sutunda excel kitabındaki sayfların adı yazıyor.
A sutundan eğer yazdır yazısı varsa yazdır butonuna basınca o sayfanın h7 hücresi dolu ise yazdırsın boş ise yazdırmasın istiyorum.
Örneğin Sayfa7 ve sayfa 8 in A sutununda yazdır yazıyor. Ama sayfa 7 nın h7 hücresi dolu olduğundan yazdırsın sayfa 8in h7 hücresi bş olduğundan yazdırmasın.

 

[İhsan Tank]

Slm,
B sutunda excel kitabındaki sayfların adı yazıyor.
A sutundan eğer yazdır yazısı varsa yazdır butonuna basınca o sayfanın h7 hücresi dolu ise yazdırsın boş ise yazdırmasın istiyorum.
Örneğin Sayfa7 ve sayfa 8 in A sutununda yazdır yazıyor. Ama sayfa 7 nın h7 hücresi dolu olduğundan yazdırsın sayfa 8in h7 hücresi bş olduğundan yazdırmasın.

Merhaba
Kodu boş bir module kopyalayarak deneyiniz

Option Explicit
Sub yazdır_şartlı_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
trabzonspor = MsgBox("Şarta Uyanları Yazıdırıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
Set kaplan = Sheets("ANASAYFA")
For ts = 2 To kaplan.Cells(Rows.Count, "B").End(xlUp).Row
If LCase(Replace(Replace(kaplan.Cells(ts, "A"), "I", "ı"), "İ", "i")) = "yazdır" And _
Sheets(kaplan.Cells(ts, "B").Text).Range("H7") <> "" Then
Sheets(kaplan.Cells(ts, "B").Text).PrintOut
End If
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Şarta Uyan Sayfaları Yazdırdım", , "Bitiş"
End Sub

 

[mahmutozdemir]

Teşekkür ederim

 

[İhsan Tank]

Teşekkür ederim

Rica ederim
:keyif:

 

[mahmutozdemir]

İhsan Bey,
sayfa1, sayfa2 sayfa3, gibi sıralı olunca yazıyor ancak sayfa1,2,3 yerine isim olunca kodun şu bölümünde hata veriyor.Yani sayfa7 yi listede en alta alıncada bu hatayı verdi
If LCase(Replace(Replace(kaplan.Cells(ts, "A"), "I", "ı"), "İ", "i")) = "yazdır" And _
Sheets(kaplan.Cells(ts, "B").Text).Range("H7") <> "" Then

 

[İhsan Tank]

Hatalı dosyanızı ekler misiniz_?

 

[mahmutozdemir]

dosya ekte

 

[İhsan Tank]

dosya ekte

Yanlız sizin istediğiniz değişmiş gibi geldi bana
Yazan ismin sayfası yok bu nasıl olacak.
Siz ilk sorunuzda bundan bahsetmemiştiniz. Sonra kod hatalı çalışıyor diyorsunuz

 

[mahmutozdemir]

Olmayan sayfalarıda ekledim.Ancak
If LCase(Replace(Replace(kaplan.Cells(ts, "b"), "I", "ı"), "İ", "i")) = "yazdır" And _
Sheets(kaplan.Cells(ts, "c").Text).Range("H7") <> "" Then hata veriyor.

 

[İhsan Tank]

Olmayan sayfalarıda ekledim.Ancak
If LCase(Replace(Replace(kaplan.Cells(ts, "b"), "I", "ı"), "İ", "i")) = "yazdır" And _
Sheets(kaplan.Cells(ts, "c").Text).Range("H7") <> "" Then hata veriyor.

Son hali ile dosyanızı günceller misiniz_?

 

[mahmutozdemir]

İhsan Bey,Son hali en son yayınladığım ekli dosya (PKT.rar)

 

[İhsan Tank]

İhsan Bey,Son hali en son yayınladığım ekli dosya (PKT.rar)

Dosyadaki sayfa adları eksik

 

[mahmutozdemir]

Ben isimleri çogaltacağım bazılarınında isimleri eksik olabilir bu nedenle sayfa eksik olsa olmaz mı?

 

[İhsan Tank]

Ben isimleri çogaltacağım bazılarınında isimleri eksik olabilir bu nedenle sayfa eksik olsa olmaz mı?

Olur tabi siz istersiniz de olmaz mı_?
Bu işi baştan söyleseydinizde bir kere uğraşsaydık daha iyi olmaz mıydı. İkinci defa kod yazdırıyorsun bize ve diğer arkadaşların hakkına giriyorsun.
Module'deki kodu bununla değiştirip deneyin.

Option Explicit
Sub sayfa_yazdır_61()
Dim ts, kaplan As Date, zicev, asi
zicev = MsgBox("Sayfaları Yazdırıyorum", vbYesNo, "Onay")
If zicev = vbNo Then Exit Sub
Application.ScreenUpdating = False
kaplan = Time
Set asi = Sheets("ANASAYFA")
For ts = 8 To Sheets.Count
If Sheets(ts).Range("H7") <> "" And _
WorksheetFunction.Index(asi.Range("B6:B" & Rows.Count), _
WorksheetFunction.Match(Sheets(ts).Name, asi.Range("C6:C" _
& Rows.Count), 0), 1) = "yazdır" Then
Sheets(ts).PrintOut
End If
Next
Application.ScreenUpdating = True
MsgBox Format(kaplan - Time, "hh:mm:ss") & vbLf _
& "Sürede İşlem Tamamlandı", , "Bitiş"
End Sub

 

[mahmutozdemir]

Çok teşekkürler elllerinize sağlık...

 

[İhsan Tank]

Çok teşekkürler elllerinize sağlık...

Rica ederim
:keyif: