Excel Otomatik Yazdırmaya Yazıcı Özellikleri Dahil Etme

[hilmi0707]

Selamlar.
Daha önce bir arkadaşımızın hazırlamış olduğu ve işimi oldukça kolaylaştıran şöyle bir kod kullanıyorum:

Sub Yazdir()
Dim WF As WorksheetFunction
Dim Ilk_No As Variant
Dim Son_No As Variant
Dim X As Long

Set WF = WorksheetFunction

Ilk_No = InputBox("Lütfen yazdırmak istediğiniz ilk sıra numarasını yazınız...", "Sıra Numarası", WF.Min(Range("A:A")))

If Ilk_No = False Or Ilk_No = "" Or Ilk_No <= 0 Then
MsgBox "İşleminiz iptal edilmiştir.", vbCritical
Exit Sub
End If

Son_No = InputBox("Lütfen yazdırmak istediğiniz son sıra numarasını yazınız...", "Sıra Numarası", WF.Max(Range("A:A")))

If Son_No = False Or Son_No = "" Or Son_No <= 0 Then
MsgBox "İşleminiz iptal edilmiştir.", vbCritical
Exit Sub
End If

For X = Ilk_No To Son_No
Range("E1") = X
ActiveSheet.PrintOut Copies:=1

Next

Set WF = Nothing


End Sub

Burada E1 hücresini birer artırarak otomatik gelen verileri yazıcıya gönderiyor. Ama birden çok yazıcımız var.

Excel sayfamızda CTRL+P yapıp bir yazıcı seçiyoruz ve YAZDIRMA İŞLEMİ YAPMADAN geri çıkıyoruz. Daha sonra düğmeye atadığımız makromuzu çalıştırdığımızda artık o yazıcıya veri gönderiyor. Burada iki sıkıntımız var.

1. Biz CTRL+P yapıp yazıcı özelliklerinde YAZDIRMA KALİTESİNİ en iyi baskı ayarını seçmiş olsak da makro yine standart ayarlarda yazdıma yapıyor.
2. Her yazıcımız için ayrı bir MAKRO DÜĞMESİ koysak, hangi düğmeye basarsak o yazıcıya veri gitse olur mu?

Yardımlarınız için teşekkür ederim.

 

[necati]

Merhaba, benim kullandığım kod işinize yarayabilir.
ActiveSheet.PrintOut Copies:=1, ActivePrinter:="HP LaserJet 1015"
Aktif yazıcı ne olursa olsun, bu satırdaki yazıcıya gönderiyor. Sonunda aktif yazıcıyı yine eskisine ayarlıyor.

Sub Yazdir()
Dim WF As WorksheetFunction
Dim Ilk_No As Variant
Dim Son_No As Variant
Dim X As Long
Dim mevcutprinter As String

Set WF = WorksheetFunction
mevcutprinter = Application.ActivePrinter

Ilk_No = InputBox("Lütfen yazdırmak istediğiniz ilk sıra numarasını yazınız...", "Sıra Numarası", WF.Min(Range("A:A")))

If Ilk_No = False Or Ilk_No = "" Or Ilk_No <= 0 Then
MsgBox "İşleminiz iptal edilmiştir.", vbCritical
Exit Sub
End If

Son_No = InputBox("Lütfen yazdırmak istediğiniz son sıra numarasını yazınız...", "Sıra Numarası", WF.Max(Range("A:A")))

If Son_No = False Or Son_No = "" Or Son_No <= 0 Then
MsgBox "İşleminiz iptal edilmiştir.", vbCritical
Exit Sub
End If

For X = Ilk_No To Son_No
Range("E1") = X
ActiveSheet.PrintOut Copies:=1, ActivePrinter:="HP LaserJet 1015"

Next

Application.ActivePrinter = mevcutprinter
Set WF = Nothing


End Sub