Makro ile dosya yazdırma

[cavanoos]

Arkadaşlar;

Nette gezinirken alttaki gibi bir kod buldum.Çalıştırdığımda filename kısmında hata alıyorum.Bir bakabilir misiniz,hatayı nerde yapıyorum.


Option Explicit

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

Private Const SW_HIDE As Long = 0
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWMINIMIZED As Long = 2


Sub Yazdir()
ShellExecute Application.hwnd, "print", filename, vbNullString, "C:\", SW_SHOWNORMAL
End Sub

 

[Husgvarna]

Arkadaşlar;

Nette gezinirken alttaki gibi bir kod buldum.Çalıştırdığımda filename kısmında hata alıyorum.Bir bakabilir misiniz,hatayı nerde yapıyorum.


Option Explicit

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

Private Const SW_HIDE As Long = 0
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWMINIMIZED As Long = 2


Sub Yazdir()
ShellExecute Application.hwnd, "print", filename, vbNullString, "C:\", SW_SHOWNORMAL
End Sub

Kırmızı bölümü:
Aşağıdaki örnekteki gibi deneyebilirsiniz.

 ShellExecute Application.hwnd, "open", "c:\y.xls", vbNullString, "C:\", SW_SHOWNORMAL
ShellExecute Application.hwnd, "print", "c:\y.xls", vbNullString, "C:\", SW_SHOWNORMAL

 

[cavanoos]

Sayın Husgvarna;

Çok teşekkür ederim.Yazdırma işlemi gerçekleşti.Elinize sağlık.Bu kodu biraz daha geliştirebilirmiyiz ? Şöyle ki;

Asıl yapmak istediğim işlem;bir klasörün içinde 300 tane pdf dosyası var.1.pdf dosyasını açacak.1.sayfasını yazdıracak.1.pdf dosyası kapatılacak.2.pdf dosyası açılacak.1.sayfasını yazdıracak ve kapatacak.Bu şekilde klasördeki bütün pdf dosyalarının ilk sayfasını yazıcıya göndermiş olacak.Bunu bir döngü içinde yapılabileceğini düşünüyorum.

Yardım edebilir misiniz ? Az ya da çok en ufak bir yardım bile bir adım ilerlememe sebep olacaktır.

 

[Husgvarna]

Sayın Husgvarna;

Çok teşekkür ederim.Yazdırma işlemi gerçekleşti.Elinize sağlık.Bu kodu biraz daha geliştirebilirmiyiz ? Şöyle ki;

Asıl yapmak istediğim işlem;bir klasörün içinde 300 tane pdf dosyası var.1.pdf dosyasını açacak.1.sayfasını yazdıracak.1.pdf dosyası kapatılacak.2.pdf dosyası açılacak.1.sayfasını yazdıracak ve kapatacak.Bu şekilde klasördeki bütün pdf dosyalarının ilk sayfasını yazıcıya göndermiş olacak.Bunu bir döngü içinde yapılabileceğini düşünüyorum.

Yardım edebilir misiniz ? Az ya da çok en ufak bir yardım bile bir adım ilerlememe sebep olacaktır.

Döngü ile klasör içindeki PDF dosyalarını yazdırmak aşağıdaki kodla mümkün

Sub Yazdir()
Dim ds, dc, f, s, dos
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder(ThisWorkbook.Path & "\DOSYA")
Set dc = f.Files
For Each dos In dc
ShellExecute Application.hwnd, "open", ThisWorkbook.Path & "\DOSYA\" & dos.Name, vbNullString, ThisWorkbook.Path & "\DOSYA\" & dos.Name, SW_SHOWNORMAL
ShellExecute Application.hwnd, "print", ThisWorkbook.Path & "\DOSYA\" & dos.Name, vbNullString, ThisWorkbook.Path & "\DOSYA\" & dos.Name, SW_SHOWNORMAL
Next
End Sub

Sayfaları tek yazdırmak için ayrı bir çalışma yapmak gerek.

 

[cavanoos]

Sayın husgvarna;

Set f = ds.GetFolder(ThisWorkbook.Path & "\DOSYA") bu satırda hata verdi. Path not found hatası.

C sürücüsünün altında TELEFON klasörünün yolunu bu koda nasıl ekleriz.

Denedim.Yol adında bir değişken oluşturdum.
yol = "C:\telefon" değer atadım.
Set f = ds.GetFolder(ThisWorkbook.Path & "\DOSYA") bu satırı
Set f = ds.GetFolder(yol) bu şekilde değiştirdim.Hata vermedi.Ama yazıcıdan çıktıda alamadım.

Yardım edebilir misiniz ?

 

[Husgvarna]

Sayın husgvarna;

Set f = ds.GetFolder(ThisWorkbook.Path & "\DOSYA") bu satırda hata verdi. Path not found hatası.

C sürücüsünün altında TELEFON klasörünün yolunu bu koda nasıl ekleriz.

Denedim.Yol adında bir değişken oluşturdum.
yol = "C:\telefon" değer atadım.
Set f = ds.GetFolder(ThisWorkbook.Path & "\DOSYA") bu satırı
Set f = ds.GetFolder(yol) bu şekilde değiştirdim.Hata vermedi.Ama yazıcıdan çıktıda alamadım.

Yardım edebilir misiniz ?

Merhaba:

 Option Explicit
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
Private Const SW_HIDE As Long = 0
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWMINIMIZED As Long = 2
Private Sub CommandButton1_Click()
Dim dc, dos
Set dc = CreateObject("Scripting.FileSystemObject").GetFolder("c:\TELEFON").Files
For Each dos In dc
ShellExecute Application.hwnd, "open", "c:\TELEFON\" & dos.Name, vbNullString, "c:\TELEFON\" & dos.Name, SW_SHOWNORMAL
ShellExecute Application.hwnd, "print", "c:\TELEFON\" & dos.Name, vbNullString, "c:\TELEFON\" & dos.Name, SW_SHOWNORMAL
   'ShellExecute Application.hwnd, "close", "c:\TELEFON\" & dos.Name, vbNullString, "c:\TELEFON\" & dos.Name, SW_SHOWNORMAL

Next
End Sub

 

[cavanoos]

Sayın husgvarna;

Elinize sağlık.Döngü çalışıyor.

Pdf dosyasını açıyoruz.Yazdırıyoruz.Kapatma kodu aktif değildi.Aktif hale getirdim.Ama kapanmadı.Çok önemli değil ama sorayım dedim.Açılan pdf dosyasını yazdırdıktan sonra kapatabilir miyiz ?

 

[Husgvarna]

Sayın husgvarna;

Elinize sağlık.Döngü çalışıyor.
Ama kapanmadı.Çok önemli değil ama sorayım dedim.Açılan pdf dosyasını yazdırdıktan sonra kapatabilir miyiz ?

Merhaba.

Açılmasının gereği yoksa:

Private Sub CommandButton1_Click()
Dim dc, dos
Set dc = CreateObject("Scripting.FileSystemObject").GetFolder("c:\TELEFON").Files
For Each dos In dc
ShellExecute Application.hwnd, "print", "c:\TELEFON\" & dos.Name, vbNullString, "c:\TELEFON\" & dos.Name, SW_SHOWNORMAL
Next
End Sub

 

[cavanoos]

Sayın husgvarna;

Elinize sağlık.Sorunum çözülmüştür.

 

[emsey]

Merhaba,

Bu koda ihtiyacım var yalnız 64bit office programında aşağıdaki kodlar hata veriyor. Bu koda ihtayacım var. Yada aynı görevi gören. Bilgisayarımdaki herhangi bir dosyası hiç açmadan direk yazdırma yapabileceğim kod arıyorum. Yardımcı olabilirseniz çok memnun olurum.

Option Explicit
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
Private Const SW_HIDE As Long = 0
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWMINIMIZED As Long = 2

 

[emsey]

Başlığı tekrar gündeme getirmiş oldum ama yardımcı olabilecek üstadların desteğini bekliyorum. Şimdiden teşekkür ederim.