Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Makro-VBA (http://www.excel.web.tr/forumdisplay.php?f=48)
-   -   Klasör içindeki dosyaları toplu yazdırma. (http://www.excel.web.tr/showthread.php?t=119477)

vatansever027 12-09-2012 19:34

Klasör içindeki dosyaları toplu yazdırma.
 
Merhaba arkadaşlar,
Üç günden beri uğraştıgım, araştırdıgım bir sorun var ama çözemedeim yardımcı olursanız çok sevinirim.Ayrı bir klasör içinde .jpg .gif .bmp uzantılı dosyalarım var. Ben bu dosyların hepsini makro ile toplu halde yazdırmak istiyorum.Yani klasörü seçtiğim zaman klasör içindeki dosyalarım yazıcıdan otomatik çıktı versin.
Not:Yazıcı seçeneğim ikitane biri normal yazıcı diğeri ise PrintPDF (PDF dönüştürücü) ikisinide kullanabilirim.
Yardımcı olursanız sevinirim.

mancubus 12-09-2012 22:34

klasörde tüm dosyaları seçtikten sonra sağ tık, yazdır, tamam. makroya gerek yok.

vatansever027 13-09-2012 09:05

sayın hocam yardımından dolayı teşekkür ederim onu biliyorum ama ben muhasebe ile ilgili bir program yapıyorum.Yapmış olduğum programın için örnek veriyorum bir klasör içinde 50 tane belge var ben bunların 10 tanesini seçiyorum ayrı bir klasör içine kopyalıyorum tabi bunların hepsini excel vb ile yapıyorum seçtikten sonra sadece yazdırma olayı kalıyor. Bir buton yaptım, o butona tıkladığım zaman ayrı klasöre kopyalanan belgelerin hepsini yazdırmasını istiyorum. Bununla ilgile bana yardımcı olursanız çok sevinirim.
iyi çalışmalar,

mancubus 13-09-2012 15:32

internet gerçekten sonsuz bir kaynak.

kodu yazanın emeğine saygı olarak ilk 4 satırı her dosyada muhafaza edelim.

ben 5 resim üzerinden denedim, sorunsuz çıktı aldım.

Application.ActivePrinter ile o anda aktif bağlantı bulunan yazıcıya gönderiliyor.

Kod:

'Written: September 15, 2010
'Author:  Leith Ross
'Summary: Printout files in a directory that have a pdf, jpg, or tif extension.
'http://www.excelforum.com/excel-programming-vba-macros/745764-print-pdf-jpeg-and-tif-files.html
 
Private Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" _
    (ByVal hWnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long

Sub PrintFiles()

    Dim DirPath As String
    Dim FileName As String
    Dim FileExt As String
    Dim RegExp As Object
    Dim RetVal
   
    DirPath = "C:\Profiles\xxxx\My Documents\resimler\" 'resim dosyalarının bulunduğu klasör
   
    Set RegExp = CreateObject("VBScript.RegExp")
    RegExp.Pattern = ".+\.(\w+)$"
   
    FileName = Dir(DirPath)
   
    Do While FileName <> ""
        FileExt = RegExp.Replace(FileName, "$1")
        Select Case LCase(FileExt)
            Case Is = "pdf"
                RetVal = ShellExecute(0&, "print", DirPath & FileName, "", "", 0&) 'pdf dosyaları basan kod
            Case "bmp", "jpg", "jpeg", "tif", "tiff" 'basılacak resimlerin uzantıları çift tırnak içinde
                RetVal = ShellExecute(0&, "printto", DirPath & FileName, Application.ActivePrinter, "", 0&)
        End Select
        FileName = Dir()
    Loop
     
End Sub


vatansever027 17-09-2012 14:01

Kardeşim yardımlarından dolayı çok teşekkür ederim ama ben bi türlü yapamadım.Kodları direk kopyaladım yapıştırdım ve kendime göre uyarladım ama çalışmadı.Hata kodu da vermiyor, yazıcıyada göndermiyor.benim dosyalarımın oldugu dizin c:\yaz
kodlara bi bakarsanız sevinirim.

mancubus 17-09-2012 15:01

c:\yaz\
en sonra "\" var değil mi?


rica ederim.

teşekkür; yaşım 26'dan bir hayli büyük olsa da... :D

vatansever027 18-09-2012 14:09

evet var birebir aynı, ".pdf" dosyalarını yazdırıyor ama ".jpg" ve diğer dosyaları yazdırmıyor. internettende araştırdım herşey doğru, resim dosyasını açıyor yani ekrana geliyor ama yazdırmıyor.
Bendeki kodlar.

Private Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub PrintFiles()

Dim DirPath As String
Dim FileName As String
Dim FileExt As String
Dim RegExp As Object
Dim RetVal

DirPath = "C:\yaz\" 'resim dosyalarının bulunduğu klasör

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Pattern = ".+\.(\w+)$"

FileName = Dir(DirPath)

Do While FileName <> ""
FileExt = RegExp.Replace(FileName, "$1")
Select Case LCase(FileExt)
Case Is = "pdf"
RetVal = ShellExecute(0&, "print", DirPath & FileName, Application.ActivePrinter, "", 0&) 'pdf dosyaları basan kod
Case "bmp", "jpg", "jpeg", "tif", "tiff" 'basılacak resimlerin uzantıları çift tırnak içinde
RetVal = ShellExecute(0&, printto, DirPath & FileName, Application.ActivePrinter, "", 0&)
End Select
FileName = Dir()
Loop

End Sub

mancubus 18-09-2012 19:32

hızlı cevap panelinde, # butonuna tıklayarak gelen köşeli parantezi içindeki CODE ve /CODE tag'lerinin (etiket) arasına kodları koymak okunmasını kıolaylaştıracaktır.
ayrıca, yazımı basit olan ve hemen her yerde bulunabilecek olanlar hariç, özellikli iş gören kodlar için mutlaka kaynak göstermek şık bir hareket olacaktır.

bunları söyledikten sonra...
dediğim gibi, başka yerden aldım, denedim, bende çalıştı, önerdim.
hakim olduğum bir konu değil. belki versiyon farkından kaynaklanıyordur. ben ofis 2010'da çalıştırdım.

pdf için çalışan kodu diğerleri için de deneyelim. belki olur.

yani dosya uzantısı ayrımına gitmeden, kodu sadeleştirerek: (test edilmemiştir.)
Kod:

Sub PrintFiles()

    Dim DirPath As String
    Dim FileName As String
    Dim RetVal
   
    DirPath = "C:\yaz\"
    FileName = Dir(DirPath)
   
    Do While FileName <> ""
        RetVal = ShellExecute(0&, "print", DirPath & FileName, "", "", 0&)
        FileName = Dir()
    Loop
     
End Sub


cihataydemir 04-11-2015 13:48

Merhabalar,

Biraz abzürt kaçabilir fakat #Private Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long#
kodlarını excel VBA Project'te nereye yapıştırmalıyız? yani Sub ve End arasında olmuyor, bilemedim.

Cevaplarınız için şimdiden teşekkürler.



Alıntı:

mancubus tarafından gönderildi (Mesaj 653677)
hızlı cevap panelinde, # butonuna tıklayarak gelen köşeli parantezi içindeki CODE ve /CODE tag'lerinin (etiket) arasına kodları koymak okunmasını kıolaylaştıracaktır.
ayrıca, yazımı basit olan ve hemen her yerde bulunabilecek olanlar hariç, özellikli iş gören kodlar için mutlaka kaynak göstermek şık bir hareket olacaktır.

bunları söyledikten sonra...
dediğim gibi, başka yerden aldım, denedim, bende çalıştı, önerdim.
hakim olduğum bir konu değil. belki versiyon farkından kaynaklanıyordur. ben ofis 2010'da çalıştırdım.

pdf için çalışan kodu diğerleri için de deneyelim. belki olur.

yani dosya uzantısı ayrımına gitmeden, kodu sadeleştirerek: (test edilmemiştir.)
Kod:

Sub PrintFiles()

    Dim DirPath As String
    Dim FileName As String
    Dim RetVal
   
    DirPath = "C:\yaz\"
    FileName = Dir(DirPath)
   
    Do While FileName <> ""
        RetVal = ShellExecute(0&, "print", DirPath & FileName, "", "", 0&)
        FileName = Dir()
    Loop
     
End Sub



DMR 7 25-12-2017 09:43

önemli bir konu güncelleyelim. bende bir soru sorayım. 10 farklı sayfası olan bir excelde de bu kodlar işe yarar mı? yani tüm sayfaları tek tek yazdırır mı? ya da nasıl yapılır?


Saat 17:02

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.