Klasör İçeriğini Toplu Yazdırma

[bjk55]

Bu dosyalar nerede? Dosya yolu belli mi?

dosya yolu "C:\Users\User\Desktop\hepsi\"

 

[bjk55]

Printer seçimi yapmak istiyor musunuz?

evet ama yazılırken tek tek tıklamayım toplu şekilde yollayabiliyor muyum

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Klasordeki_Dosyalari_Yazdir()
    Dim Tanimli_Printer As String, Printer_Secimi As Variant
    Dim Yol As String, Dosya As String, Say As Long, Rng As Range
    
    Tanimli_Printer = Application.ActivePrinter
    
    Printer_Secimi = Application.Dialogs(xlDialogPrinterSetup).Show
    If Printer_Secimi = False Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        
    Yol = "C:\Users\User\Desktop\hepsi\"
    
    For Each Rng In Range("A2:A" & Cells(Rows.Count, 1).End(3).Row)
        If Rng.Value <> "" Then
            Dosya = Dir(Yol & Rng.Value)
            If Dosya <> "" Then
                DoEvents
                Say = Say + 1
                CreateObject("Shell.Application").Namespace(0).ParseName(Yol & Dosya).InvokeVerb ("Print")
            End If
        End If
    Next
    
    Application.ActivePrinter = Tanimli_Printer
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    If Say = 0 Then
        MsgBox "Yazdırılacak dosya bulunamadı!", vbExclamation
    Else
        MsgBox "Seçtiğiniz klasördeki dosyalar yazdırılmıştır.", vbInformation
    End If
End Sub

 

[bjk55]

Çok Teşekkür ederim Korhan Bey, yazıcıya yollarken tek tek yollamasam direk yazıcıya gönderse olurmu

 

[Korhan Ayhan]

Sütundaki verileri döngüye alarak ne kadar veri varsa hepsini yazıcıya göndermiyor mu?

 

[bjk55]

resim yazdırma çıkıyor hepsi için ayrı ayrı

 

[Korhan Ayhan]

Bu kodu deneyiniz.

Option Explicit

Sub Klasordeki_Dosyalari_Yazdir()
    Dim S1 As Worksheet, Rng As Range
    Dim Tanimli_Printer As String, Printer_Secimi As Variant
    Dim Yol As String, Dosya As String, Say As Long
  
    Set S1 = Sheets("Sayfa1")

    Tanimli_Printer = Application.ActivePrinter
  
    Printer_Secimi = Application.Dialogs(xlDialogPrinterSetup).Show
    If Printer_Secimi = False Then Exit Sub
  
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
      
    Yol = "C:\Users\User\Desktop\hepsi\"

    For Each Rng In S1.Range("A2:A" & S1.Cells(S1.Rows.Count, 1).End(3).Row)
        If Rng.Value <> "" Then
            Dosya = Dir(Yol & Rng.Value)
            If Dosya <> "" Then
                DoEvents
                Say = Say + 1
                Shell ("cmd /c mspaint /p "" & Yol & Dosya & """)
            End If
        End If
    Next
  
    Application.ActivePrinter = Tanimli_Printer
  
    Set S1 = Nothing

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
  
    If Say = 0 Then
        MsgBox "Yazdırılacak dosya bulunamadı!", vbExclamation
    Else
        MsgBox "Seçtiğiniz klasördeki dosyalar yazdırılmıştır.", vbInformation
    End If
End Sub

 

[oydemir]

Korhan Ayhan bey bana lazım olan konuyu araştırıyordum sizin makroları gördüm arkadaşım sorduğu konu beni ilgilendiren konu yazdırılacak dosya yolu belli olunca ilgili klasörlerdeki sayfa1 de ki sıraya göre nasıl yazdırabilirim. Teşekkürler

 

[oydemir]

Korhan bey sayfa1 de yolu belli dosyaları yazdırmak istiyorum yazıcı secimi yapmak istemiyorum klasörüm ağda ve tif uzantılı

 

[oydemir]

Korhan Ayhan bey bana lazım olan konuyu araştırıyordum sizin makroları gördüm arkadaşım sorduğu konu beni ilgilendiren konu yazdırılacak dosya yolu belli olunca ilgili klasörlerdeki sayfa1 de ki sıraya göre nasıl yazdırabilirim. Ekteki hatayı alıyorum pait açılmıyor birde dosyaları görmeden yazdırmak mümkün mü Teşekkürler

 

[Korhan Ayhan]

Deneyip sonucu bildirirsiniz.

Option Explicit

Sub Klasordeki_Dosyalari_Yazdir()
    Dim S1 As Worksheet, Rng As Range
    Dim Dosya As String, Say As Long
  
    Set S1 = Sheets("Sayfa1")

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
      
    For Each Rng In S1.Range("A2:A" & S1.Cells(S1.Rows.Count, 1).End(3).Row)
        If Rng.Value <> "" Then
            Dosya = Dir(Rng.Value)
            If Dosya <> "" Then
                DoEvents
                Say = Say + 1
                Shell ("cmd /c mspaint /p """ & Rng.Value & """")
            End If
        End If
    Next
  
    Set S1 = Nothing

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
  
    If Say = 0 Then
        MsgBox "Yazdırılacak dosya bulunamadı!", vbExclamation
    Else
        MsgBox "Seçtiğiniz klasördeki dosyalar yazdırılmıştır.", vbInformation
    End If
End Sub

 

[oydemir]

Koray bey öncelikçe ilginize teşekkür ederim
hala aldığım hatalar devam ediyor.

 

[Korhan Ayhan]

Merhaba,

Kodu revize ettim. Tekrar deneyiniz.

 

[oydemir]

teşekkürler elinize sağlık sorun yok

 

[spasmex97]

benzer bir çalışmayı acrobat reader yüklü olmayan bilgisayarda pdf dosyalarını çıkartmak için yapmak mümkün mü ?

 

[spasmex97]

aynısını .pdf uzantılı dosyalar için deniyorum, düzenleme de yaptım fakat direkt runtime error 91 object variable or with block variable not set hatası alıyorum