PDF yazdırmada Yazıcı koşulu ekleme

[acar6783]

Hayırlı günler arkadaşlar,
Aşağıdaki kodlar ile pdf azdırıyorum fakat yazıcı koşulu ekleyemedim ?

Kırmızı satırdaki kod ile tanımlama yapıyorum fakat yine de diğer yazıcıya gidiyor

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

Dim yol
Sub Yazdır()

Dim ds, a
Set ft = Sheets("FaturaTakip")
dosya = Cells(ActiveCell.Row, "E").Value

yol = ThisWorkbook.Path & "\Faturalar\" & dosya & ".pdf"
If Dir(yol) = "" Then MsgBox dosya & " Nolu Fatura Klasörde Bulunamadı!!!", vbCritical + vbOKOnly, "Hata": End

[COLOR="Red"][B]Application.ActivePrinter = ft.Range("J1")[/B][/COLOR]
'ShellExecute Application.hwnd, "open", yol, vbNullString, left(yol,3), SW_SHOWNORMAL

ShellExecute Application.hwnd, "print", yol, vbNullString, Left(yol, 3), SW_HIDE


End Sub

 

[acar6783]

Bu konuda herhangi bir fikri olan yokmudur?

 

[halit3]

Benim bilgisayarda

Application.ActivePrinter = "Ne01: üzerindeki OneNote 2007'ye Gönder "

bu şekilde yazdırıyor

Application.ActivePrinter = "Ne01: üzerindeki OneNote 2007'ye Gönder"

bu şekilde yazdırmıyor

Buradaki fark Göder yazısından sonraki boşluk belki sizinkide aynıdır.

 

[acar6783]

Benim bilgisayarda

Application.ActivePrinter = "Ne01: üzerindeki OneNote 2007'ye Gönder "

bu şekilde yazdırıyor

Application.ActivePrinter = "Ne01: üzerindeki OneNote 2007'ye Gönder"

bu şekilde yazdırmıyor

Buradaki fark Göder yazısından sonraki boşluk belki sizinkide aynıdır.

Halit bey merhaba,
Yzdırmada sorunum yok yazıcıya gidiyor fakat sürekli aynı yazıcıya gidiyor.
Sanırım pdf yazdırdığım için oluyor

 

[acar6783]

Sanırım sorun sistem varsayılan yazıcısını değiştirmede.
Onun için bu kodları kullanacağım :
CreateObject("WScript.Network").SetDefaultPrinter ft.Range("J1").Value

PAzartesi deneyeip bilgi vereceğim .

 

[acar6783]

Sanırım sorun sistem varsayılan yazıcısını değiştirmede.
Onun için bu kodları kullanacağım :
CreateObject("WScript.Network").SetDefaultPrinter ft.Range("J1").Value

PAzartesi deneyeip bilgi vereceğim .

Maalesef evdeki pcde sorun var sanıyordum fakat yazıcının bağlı olduğu pcde de aynı hatayı veriyor.
Hatta yazcı adı hatalı yazdığımı düşünerek aşağdaki kodu denedim yine hata veriyor.

Alternatif yol bulamadım

Sub yaz()

yazıcı = Application.ActivePrinter
CreateObject("WScript.Network").SetDefaultPrinter yazıcı
End Sub

 

[acar6783]

Sorunumu çözdüm arkadaşlar.
Ekte videosu mevcuttur. Deneme amaçlı evdeki pcdeki sistem yazıcılarında denedim çalıştı. Sistemüzerinde varsayılan yazıcıyı değiştirebiliyorum.
Kodlar genişletilebilir ihtiyaca göre. Hayırlı akşamlar.

https://youtu.be/uY_0-ilFDY8

 

[acar6783]

Örnek dosya...
İhtiyacı olanlar için...