Çalışma Kitabı Sayfalarını Yazdırma

[karasert5]

Arkadaşlar hazırladığım exel çalışma kitabımda bulunan sayfa 2'den sayfa 16'ya kadar olan sayfaları yazdırma makrosu hazırladım ama bir türlü çalıştıramıyorum.

İstediğim aslında basit bir kod ama çözümü bulamıyorum. Sadece yazdırma alanı belirlenmiş olan istenilen sayfaları tek bir buton ile yazdırma makrosu. Yardımcı olursanız çok sevinirim.

 

[Orion1]

Buyurun.

Dim i As Byte
For i = 2 To 16
    Sheets(i).PrintOut
Next i

 

[karasert5]

Teşekkür ederim. Emeklerinize sağlık.

 

[karasert5]

kodu bugün deneme şansım oldu bütün sayfaları yazdırdı. ama orjinal haliyle çalışmadı sub ve end sub ekleyince çalıştı. onda da bütün sayfaları yazdırdı. sayfa numaralarını eklemeli bir kod yazılabilir mi?

 

[Orion1]

kodu bugün deneme şansım oldu bütün sayfaları yazdırdı. ama orjinal haliyle çalışmadı sub ve end sub ekleyince çalıştı. onda da bütün sayfaları yazdırdı. sayfa numaralarını eklemeli bir kod yazılabilir mi?

Elbette sub-endsub arasına yazılmalı.
Ben onu nesne içerisinede yazdırabileceğinizi düşündümde ondan başlarına sub bitişinede end sub yazmadım.
Kodun çalışmasına gelince tüm sayfaları yazdırmıyor.
İlk sayfa hariç 16ncı sayfaya kadar yazdırıyor.
Zira siz öyle istemişsiniz.
2nci sayfadan 16ncı sayfaya kadar yazdırılsın istemiştiniz.
indis 2 ile 16 arasıdır.

 

[karasert5]

emeğinize teşekkür ederim. isteğimiz birden fazla sayfa numaralarını belirterek yazdırma şansımız var mı?

 

[Korhan Ayhan]

Deneyiniz.

Sub SEÇİME_GÖRE_YAZDIR()
    Dim Seçim As String, X As Integer
    
    Seçim = Application.InputBox("Yazdırma istediğiniz sayfa numaralarını aralarına virgül ekleyerek aşağıdaki gibi giriniz." & _
    Chr(10) & Chr(10) & "1,3,5", "Yazdırılacak Sayfa Numaralarını Giriniz.")
    
    If Seçim = "" Or Seçim = "False" Then Exit Sub
    
    If InStr(1, Seçim, ",") = 0 Then
        Sheets(Val(Seçim)).PrintOut
    Else
        Sayfalar = Split(Seçim, ",")
        
        For X = LBound(Sayfalar) To UBound(Sayfalar)
            Sheets(Val(Sayfalar(X))).PrintOut
        Next
    End If
    
    MsgBox "Seçtiğiniz sayfalar yazdırılmıştır.", vbInformation
End Sub

 

[miradakalibrasyon]

merhaba arkadaşlar, bir sorum olacak exel de örnek veriyorum 10 adet çalışma kitabı farklı isimlerle bu çalışma kitaplarının sadece 1 inci sayfalarını tek seferde nasıl yazdırabilirim.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.
Dosyaların olduğu klasör yolu ve adı bölümünü kendinize göre uyarlarsınız.

Sub Sayfa_Yazdir()

    Dim klasor As String, dosya

    klasor = "C:\deneme" 'dosya yolu ve adı

    Application.ScreenUpdating = False
    
    For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder(klasor).Files
        If ThisWorkbook.Name <> dosya.Name Then
            Workbooks.Open Filename:=dosya
                Sheets("Sayfa1").PrintOut
            ActiveWorkbook.Close True
        End If
    Next

    Application.ScreenUpdating = True

End Sub

.