Klasör içindeki dosyaları toplu yazdırma.

vatansever027 · 12 Eylül 2012

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 · 13 Eylül 2012

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

vatansever027 · 13 Eylül 2012

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 Eylül 2012

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 Eylül 2012

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 Eylül 2012

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

rica ederim.

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

vatansever027 · 18 Eylül 2012

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 Eylül 2012

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 · 4 Kasım 2015

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.

mancubus' Alıntı:
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 Aralık 2017

ö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?

sward175 · 25 Aralık 2017

DMR 7, Merhaba,

Bahsini yaptığınız excel içindeki sayfalar ise zaten sayfaların yazdırma alanları belirlenmiş demektir.
İlk sayfadasınız Shift' e basılı tutarak yazdırmak istediğiniz son sayfa ismine fare ( maus ) ile dokunun; Ardından yazdır komutu ile tüm sayfaları yazdırabilirsiniz.
Saygılarımla,
sward175

DMR 7 · 25 Aralık 2017

sward175' Alıntı:
DMR 7, Merhaba,

Bahsini yaptığınız excel içindeki sayfalar ise zaten sayfaların yazdırma alanları belirlenmiş demektir.
İlk sayfadasınız Shift' e basılı tutarak yazdırmak istediğiniz son sayfa ismine fare ( maus ) ile dokunun; Ardından yazdır komutu ile tüm sayfaları yazdırabilirsiniz.
Saygılarımla,
sward175

hocam sagolasın. yalnız benim bir excel sayfamda 50 tane sheet var. tek tek tıklamak sorun. ve çıktı alırken bunun gibi bilmem kaç excelden çıktı alıcam.

vatansever027 · 2 Ocak 2018

kardeşim bir deaşagıdaki kodu dene.
öncelikle userforma aşagıdaki öğeleri ekle
1 adet listbox
2 adet CommandButton
1 adet checkbox

Private Sub CheckBox1_Click()
Dim iloop As Integer

For iloop = 1 To ListBox1.ListCount
ListBox1.Selected(iloop - 1) = CheckBox1.Value
Next
End Sub
Private Sub CommandButton1_Click()
Dim iloop As Integer
For iloop = 1 To ListBox1.ListCount
If ListBox1.Selected(iloop - 1) = True Then
Sheets(ListBox1.List(iloop - 1, 0)).PrintOut
ListBox1.Selected(iloop - 1) = False
End If
Next
End Sub

Private Sub CommandButton2_Click()

Dim iloop As Integer
For iloop = 1 To ListBox1.ListCount
If ListBox1.Selected(iloop - 1) = True Then
Sheets(ListBox1.List(iloop - 1, 0)).PrintPreview
ListBox1.Selected(iloop - 1) = False
End If
Next
End Sub

Private Sub UserForm_Initialize()
Dim sSheet
For Each sSheet In Sheets
ListBox1.AddItem sSheet.Name
Next sSheet
'*******************************
'eğer listbox istediğiniz sayfaların gösterilmesini istiyorsanız
'yukarıdaki prosedürü silin ve aşağıdaki kodların başındaki ' işaretini silin

'For pir = 1 To Worksheets.Count 'sayfaları sayar
' If Right(Worksheets(pir).Name, 5) = "Dönem" Then 'eğer sağdan son 5 harfi dönem ile bitenler var ise
' ListBox1.AddItem Worksheets(pir).Name ' listbox a alır
'End If
'Next
End Sub

UserİGU · 5 Mayıs 2020

Bende birşey sormak istiyorum aslında konu @vatansever027 arkadaşınkiyle aynı.

Bir klasör içinde 10-15 tane excel dosyası var bunları arkalı-önlü olacak şekilde 4 er tane kopya çıkartmam gerekiyor. Bunun için herhangi bir excel dosyasında yapabileceğim bir macroyla veya başka bir şekilde nasıl direk tek tuşla çıkartabilirim?

spasmex97 · 22 Temmuz 2024

köprü ile url sini bir isme atadığım dosyaları nasıl yazdırablirim?

Klasör içindeki dosyaları toplu yazdırma.

vatansever027

mancubus

Destek Ekibi

vatansever027

mancubus

Destek Ekibi

vatansever027

mancubus

Destek Ekibi

vatansever027

mancubus

Destek Ekibi

cihataydemir

DMR 7

sward175

Özel Üye

DMR 7

vatansever027

UserİGU

spasmex97