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

Utekiner · 28 Temmuz 2019

Merhaba;

Bir klasör içerisinde çok sayıda dosyalar yer almaktadır. (pdf - xls - jpg uzantılı). (50 ile 200 Adet)

Kod yardımı ile toplu yazdırma işlemi yapmak istiyorum.

-İlk adım Klasör seçeneğinin açılması
-İkinci adım ise Sistem üzerindeki çıktıları alacağım yazıcıyı belirlemek istiyorum.

Eğer mümkün ise Sayfanın A:A sutünuna çıktı alınan dosyanın adını yazmasını B:B sütununa ise Çıktı Alındı yazması yapılabilir mi_? Konu hakkında desteğinizi bekliyorum.
Saygılarımla.

gicimi · 4 Ağustos 2019

Merhaba;
Sitede bir kaç örnek var ama sizin isteğinizi karşılayabilir. Sistemde tanımlı yazıcıya otomatik gönderiyor. Başka bir işlem yapmıyor. Sitedeki üstadlar konu hakkında size destek olabilir.

askm · 4 Ağustos 2019

Öncelikle dosya isimlerini listeleyin. Sonrasında o belgeleri yazdırın. Ama pdf yazdırmak ve jpg yazdırmak için ayrı kodlar yazmak gerek diye biliyorum.

Utekiner · 4 Ağustos 2019

Klasör içindeki dosya uzantılarını .pdf olarak düşününüz.

Utekiner · 5 Ağustos 2019

Merhaba;

Konu güncel. Bu şekilde bir şey yapılamıyor mu _? hiç olmadı bir üstad olur yada olmaz diye dönüş yaparsa süper olur.

Korhan Ayhan · 5 Ağustos 2019

Evde yazıcım olmadığı için deneme şansım olmadı. Siz deneyip sonucu bildirir misiniz?

Kod:

Option Explicit

Sub Klasordeki_Dosyalari_Yazdir()
    Dim Tanimli_Printer As String, Printer_Secimi As Variant
    Dim Klasor As Variant, Yol As String, Dosya As String, Satir As Long
    Dim Gorev_Yoneticisi As Object, Uygulamalar As Variant, Uygulama As Object
    
    Tanimli_Printer = Application.ActivePrinter
    
    Printer_Secimi = Application.Dialogs(xlDialogPrinterSetup).Show
    If Printer_Secimi = False Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Range("A:B").Clear
    Range("A1:B1") = Array("DOSYA ADI", "AÇIKLAMA")
    Range("A1:B1").Font.Bold = True
    Satir = 2
    
    Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör Seçiniz...", 1)
                        
    If Klasor Is Nothing Then Exit Sub
        
    Yol = Klasor.Items.Item.Path & Application.PathSeparator
    
    Dosya = Dir(Yol & "*.*")
    
    While Dosya <> ""
        DoEvents
        CreateObject("Shell.Application").Namespace(0).ParseName(Yol & Dosya).InvokeVerb ("Print")
        Cells(Satir, 1) = Dosya
        Cells(Satir, 2) = "Çıktı Alındı"
        Satir = Satir + 1
        Dosya = Dir
    Wend
    
    Range("A:B").EntireColumn.AutoFit
    
    Application.Wait Now + TimeValue("00:00:10")
    
    Set Gorev_Yoneticisi = GetObject("winmgmts:")
    Set Uygulamalar = Gorev_Yoneticisi.ExecQuery("Select * from Win32_Process")
    
    On Error Resume Next
    
    For Each Uygulama In Uygulamalar
        If InStr(1, Uygulama.Name, "Adobe", vbTextCompare) > 0 Or _
           InStr(1, Uygulama.Name, "OneNote", vbTextCompare) > 0 Then
            Uygulama.Terminate
        End If
    Next
    
    On Error GoTo 0
    
    Application.ActivePrinter = Tanimli_Printer
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    If Range("A2") = "" 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

Utekiner · 5 Ağustos 2019

Sn. Korhan Bey çok teşekkür ederim her zaman ki gibi hızır gibi yetiştiniz. Yarın sunucu belirteceğim. Evde benimde yazıcım yok.

gicimi · 5 Ağustos 2019

@Korhan Ayhan Bey Selamlar,
Kodu denedim. Kod çalışıyor ama şöyle bir durum var, "Adobe ve OneNote" uygulamalarını otomatik çalıştırıyor. Bunun için bir kodda revize yapılabilir mi_?

Korhan Ayhan · 5 Ağustos 2019

Merhaba,

Kodu deneme fırsatınız oldu mu?

Utekiner · 5 Ağustos 2019

@Korhan Ayhan Bey Merhaba;
Kodu denedim. Adobe Reader açılıyor ve klasör içeriğini yazıyor. @gicimi Bey'in dediği gibi Abode açılmasa olur mu veya açıldığında tüm belgeleri yazdırdıktan sonra adobe programını kapatabilir mi.

Korhan Ayhan · 8 Ağustos 2019

Merhaba,

#6 nolu mesajımdaki kodu revize ettim. Tekrar deneyip sonucu bildirir misiniz?

Utekiner · 11 Ağustos 2019

@Korhan Ayhan Bey iyi bayramlar.
Kodu denedim. Kod çalıştığında adobe açılıyor ve otomatik kapatmıyor.

gicimi · 8 Mart 2022

Korhan Ayhan' Alıntı:

Evde yazıcım olmadığı için deneme şansım olmadı. Siz deneyip sonucu bildirir misiniz?

Kod:

Option Explicit

Sub Klasordeki_Dosyalari_Yazdir()
    Dim Tanimli_Printer As String, Printer_Secimi As Variant
    Dim Klasor As Variant, Yol As String, Dosya As String, Satir As Long
    Dim Gorev_Yoneticisi As Object, Uygulamalar As Variant, Uygulama As Object
  
    Tanimli_Printer = Application.ActivePrinter
  
    Printer_Secimi = Application.Dialogs(xlDialogPrinterSetup).Show
    If Printer_Secimi = False Then Exit Sub
  
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
  
    Range("A:B").Clear
    Range("A1:B1") = Array("DOSYA ADI", "AÇIKLAMA")
    Range("A1:B1").Font.Bold = True
    Satir = 2
  
    Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör Seçiniz...", 1)
                      
    If Klasor Is Nothing Then Exit Sub
      
    Yol = Klasor.Items.Item.Path & Application.PathSeparator
  
    Dosya = Dir(Yol & "*.*")
  
    While Dosya <> ""
        DoEvents
        CreateObject("Shell.Application").Namespace(0).ParseName(Yol & Dosya).InvokeVerb ("Print")
        Cells(Satir, 1) = Dosya
        Cells(Satir, 2) = "Çıktı Alındı"
        Satir = Satir + 1
        Dosya = Dir
    Wend
  
    Range("A:B").EntireColumn.AutoFit
  
    Application.Wait Now + TimeValue("00:00:10")
  
    Set Gorev_Yoneticisi = GetObject("winmgmts:")
    Set Uygulamalar = Gorev_Yoneticisi.ExecQuery("Select * from Win32_Process")
  
    On Error Resume Next
  
    For Each Uygulama In Uygulamalar
        If InStr(1, Uygulama.Name, "Adobe", vbTextCompare) > 0 Or _
           InStr(1, Uygulama.Name, "OneNote", vbTextCompare) > 0 Then
            Uygulama.Terminate
        End If
    Next
  
    On Error GoTo 0
  
    Application.ActivePrinter = Tanimli_Printer
  
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
  
    If Range("A2") = "" 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

Korhan Hocam Selam,

Yazmış olduğunuz kodda güncelleme konusunda destek olabilir misiniz.

Kodu sadeleştirmeye çalıştım ama yapamadım.
Klasör seçimi, Yazıcı Seçimi,
Farklı bir çalışmama eklenti olarak klasör içerisindeki dosyaları yazdırmak istedim.

PHP:

Option Explicit

Sub Klasordeki_Dosyalari_Yazdir()
Dim Tanimli_Printer As String, Printer_Secimi As Variant
Dim Gorev_Yoneticisi As Object


Tanimli_Printer = Application.ActivePrinter
   
    Printer_Secimi = Application.Dialogs(xlDialogPrinterSetup).Show
    If Printer_Secimi = False Then Exit Sub
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör Seçiniz...", 1)
                       
    If Klasor Is Nothing Then Exit Sub
       
    Yol = Klasor.Items.Item.Path & Application.PathSeparator
   
    Dosya = Dir(Yol & "*.*")
   
    While Dosya <> ""
        DoEvents
        CreateObject("Shell.Application").Namespace(0).ParseName(Yol & Dosya).InvokeVerb ("Print")
    Wend
       
     Application.Wait Now + TimeValue("00:00:10")
   
    Set Gorev_Yoneticisi = GetObject("winmgmts:")
    Set Uygulamalar = Gorev_Yoneticisi.ExecQuery("Select * from Win32_Process")
   
    On Error Resume Next
   
     On Error GoTo 0
   
    Application.ActivePrinter = Tanimli_Printer
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
    MsgBox "Seçtiğiniz klasördeki dosyalar yazdırılmıştır.", vbInformation
   
    End Sub

Korhan Ayhan · 8 Mart 2022

Sadeleştirmekten kastınız nedir?

gicimi · 8 Mart 2022

Korhan Hocam,
Klasör seçimi, Yazıcı Seçimi, yapıp çıktı almak istiyorum.
Excele herhangi bir şey yazdırmasına gerek yok.

Korhan Ayhan · 8 Mart 2022

Deneyiniz.

C++:

Option Explicit

Sub Klasordeki_Dosyalari_Yazdir()
    Dim Tanimli_Printer As String, Printer_Secimi As Variant
    Dim Klasor As Variant, Yol As String, Dosya As String, Say As Long
    Dim Gorev_Yoneticisi As Object, Uygulamalar As Variant, Uygulama As Object
    
    Tanimli_Printer = Application.ActivePrinter
    
    Printer_Secimi = Application.Dialogs(xlDialogPrinterSetup).Show
    If Printer_Secimi = False Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        
    Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör Seçiniz...", 1)
                        
    If Klasor Is Nothing Then Exit Sub
        
    Yol = Klasor.Items.Item.Path & Application.PathSeparator
    
    Dosya = Dir(Yol & "*.*")
    
    While Dosya <> ""
        DoEvents
        Say = Say + 1
        CreateObject("Shell.Application").Namespace(0).ParseName(Yol & Dosya).InvokeVerb ("Print")
        Dosya = Dir
    Wend
    
    Application.Wait Now + TimeValue("00:00:10")
    
    Set Gorev_Yoneticisi = GetObject("winmgmts:")
    Set Uygulamalar = Gorev_Yoneticisi.ExecQuery("Select * from Win32_Process")
    
    On Error Resume Next
    
    For Each Uygulama In Uygulamalar
        If InStr(1, Uygulama.Name, "Adobe", vbTextCompare) > 0 Or _
           InStr(1, Uygulama.Name, "OneNote", vbTextCompare) > 0 Then
            Uygulama.Terminate
        End If
    Next
    
    On Error GoTo 0
    
    Application.ActivePrinter = Tanimli_Printer
    
    Set Klasor = Nothing
    Set Gorev_Yoneticisi = Nothing
    Set Uygulamalar = 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

gicimi · 8 Mart 2022

Teşekkürler…

bjk55 · 23 Mart 2023

Merhaba ben Excel de A sutunun da yazılan jpg ya da jpeg dosyalarının excelde ki sırayla yazılmasını istiyorum ne yapmam gerek

Korhan Ayhan · 23 Mart 2023

Bu dosyalar nerede? Dosya yolu belli mi?

Korhan Ayhan · 23 Mart 2023

Printer seçimi yapmak istiyor musunuz?

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

Utekiner

gicimi

askm

Destek Ekibi

Utekiner

Utekiner

Korhan Ayhan

Administrator

Utekiner

gicimi

Korhan Ayhan

Administrator

Utekiner

Korhan Ayhan

Administrator

Utekiner

gicimi

Korhan Ayhan

Administrator

gicimi

Korhan Ayhan

Administrator

gicimi

bjk55

Ekli dosyalar

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator