Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 12-09-2012, 20:34   #1
vatansever027
 
Giriş: 20/12/2008
Mesaj: 61
Excel Vers. ve Dili:
office 2003 türkçe
Varsayılan 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.

Bu mesaj en son " 12-09-2012 " tarihinde saat 20:38 itibariyle vatansever027 tarafından düzenlenmiştir.... Neden: yazım hatası
vatansever027 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 12-09-2012, 23:34   #2
mancubus
Destek Ekibi
 
mancubus kullanıcısının avatarı
 
Giriş: 06/01/2010
Şehir: İ>S>T>A>N>B>U>L
Mesaj: 2,048
Excel Vers. ve Dili:
İŞ: 2013 Eng EV: 2016 Eng
Varsayılan

klasörde tüm dosyaları seçtikten sonra sağ tık, yazdır, tamam. makroya gerek yok.
mancubus Çevrimdışı   Alıntı Yaparak Cevapla
Eski 13-09-2012, 10:05   #3
vatansever027
 
Giriş: 20/12/2008
Mesaj: 61
Excel Vers. ve Dili:
office 2003 türkçe
Varsayılan

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,
vatansever027 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 13-09-2012, 16:32   #4
mancubus
Destek Ekibi
 
mancubus kullanıcısının avatarı
 
Giriş: 06/01/2010
Şehir: İ>S>T>A>N>B>U>L
Mesaj: 2,048
Excel Vers. ve Dili:
İŞ: 2013 Eng EV: 2016 Eng
Varsayılan

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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
'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
mancubus Çevrimdışı   Alıntı Yaparak Cevapla
Eski 17-09-2012, 15:01   #5
vatansever027
 
Giriş: 20/12/2008
Mesaj: 61
Excel Vers. ve Dili:
office 2003 türkçe
Varsayılan

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.
vatansever027 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 17-09-2012, 16:01   #6
mancubus
Destek Ekibi
 
mancubus kullanıcısının avatarı
 
Giriş: 06/01/2010
Şehir: İ>S>T>A>N>B>U>L
Mesaj: 2,048
Excel Vers. ve Dili:
İŞ: 2013 Eng EV: 2016 Eng
Varsayılan

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


rica ederim.

teşekkür; yaşım 26'dan bir hayli büyük olsa da...
mancubus Çevrimdışı   Alıntı Yaparak Cevapla
Eski 18-09-2012, 15:09   #7
vatansever027
 
Giriş: 20/12/2008
Mesaj: 61
Excel Vers. ve Dili:
office 2003 türkçe
Varsayılan

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
vatansever027 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 18-09-2012, 20:32   #8
mancubus
Destek Ekibi
 
mancubus kullanıcısının avatarı
 
Giriş: 06/01/2010
Şehir: İ>S>T>A>N>B>U>L
Mesaj: 2,048
Excel Vers. ve Dili:
İŞ: 2013 Eng EV: 2016 Eng
Varsayılan

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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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
mancubus Çevrimdışı   Alıntı Yaparak Cevapla
Eski 04-11-2015, 14:48   #9
cihataydemir
 
Giriş: 04/11/2015
Şehir: İSTANBUL
Mesaj: 1
Excel Vers. ve Dili:
2013 TÜRKÇE
Varsayılan

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ı Görüntüle
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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 25-12-2017, 10:43   #10
DMR 7
 
Giriş: 14/09/2017
Şehir: Ankara
Mesaj: 77
Excel Vers. ve Dili:
2010 / Tr
Varsayılan

ö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?
DMR 7 Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 06:54


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Rampa- Rotary- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Çorlu Sürücü Kursu- Şişli Avukat- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kaplan Tekstil- Çorlu Perde- Çorlu Havuz- Makina- Danışmazlar-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden