Soru YAZICIYI OTOMATİK SEÇME

[mc_exrem]

Merhaba arkadaşlar,

excelde sadece kullandığım sayfada çıktı alırken yazıcının otomatik olarak "Zebra TLP2844" yazıcısını seçmesi mümkün mü acaba? (Kullandığım sayfa OTOMATİK ETİKET yazan kısım. Kod ile daha önce çıktı sayısını ayarlamıştık,)

https://drive.google.com/file/d/1-AOUCWyI_EoxVtzKebSdNMk4DvZkzyGr/view?usp=sharing

 

[Haluk]

Yazıcı olmadığı deneme şansım yok;

Sub Test()
    Dim myPrinter As String
    Dim printer_name As String
    printer_name = "Zebra TLP2844"

    myPrinter = Application.ActivePrinter
    ActiveSheet.PrintOut Preview:=False, ActivePrinter:=printer_name
    Application.ActivePrinter = myPrinter
End Sub

.

 

[mc_exrem]

Yazıcı olmadığı deneme şansım yok;

Sub Test()
    Dim myPrinter As String
    Dim printer_name As String
    printer_name = "Zebra TLP2844"

    myPrinter = Application.ActivePrinter
    ActiveSheet.PrintOut Preview:=False, ActivePrinter:=printer_name
    Application.ActivePrinter = myPrinter
End Sub

.

vaysayılan yazıcıya gönderdi. Başka kod deneyebilir miyiz?

 

[Haluk]

Göndermek istediğiniz yazıcının "Zebra TLP2844" olduğundan emin olun, bence

.

 

[mc_exrem]

Göndermek istediğiniz yazıcının "Zebra TLP2844" olduğundan emin olun, bence

.

evet eminim kodu doğru mu ekliyorum kontrol amaçlı video ekledim.
WhatsApp Video 2018-10-10 at 11.31.20.mp4 - 5.9 MB

 

[Haluk]

evet eminim

Aşağıdakileri bir modüle yerleştirip, Test isimli makroyu çalıştırın.

MsgBox ile gelen cevap, sizin yazıcı adı olması gerekir. Daha önceki kodda bu yazıcı adını (olduğu gibi) kullanıp, tekrar deneyin.

Sub Test()
  MsgBox GetFullPrintrName("Zebra TLP2844")
End Sub

Public Function GetPrinterPort(strPrinterName As String) As String
  Dim objReg As Object, strRegVal As String, strValue As String
  Const HKEY_CURRENT_USER = &H80000001
  Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
  strRegVal = "Software\Microsoft\Windows NT\CurrentVersion\PrinterPorts\"
  objReg.getstringvalue HKEY_CURRENT_USER, strRegVal, strPrinterName, strValue
  GetPrinterPort = Split(strValue, ",")(1)
End Function

Public Function GetFullPrintrName(strPrinterName As String) As String
    GetFullPrintrName = strPrinterName & " on " & GetPrinterPort(strPrinterName)
End Function

.

 

[mc_exrem]

Aşağıdakileri bir modüle yerleştirip, Test isimli makroyu çalıştırın.

MsgBox ile gelen cevap, sizin yazıcı adı olması gerekir. Daha önceki kodda bu yazıcı adını (olduğu gibi) kullanıp, tekrar deneyin.

Sub Test()
  MsgBox GetFullPrintrName("Zebra TLP2844")
End Sub

Public Function GetPrinterPort(strPrinterName As String) As String
  Dim objReg As Object, strRegVal As String, strValue As String
  Const HKEY_CURRENT_USER = &H80000001
  Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
  strRegVal = "Software\Microsoft\Windows NT\CurrentVersion\PrinterPorts\"
  objReg.getstringvalue HKEY_CURRENT_USER, strRegVal, strPrinterName, strValue
  GetPrinterPort = Split(strValue, ",")(1)
End Function

Public Function GetFullPrintrName(strPrinterName As String) As String
    GetFullPrintrName = strPrinterName & " on " & GetPrinterPort(strPrinterName)
End Function

.

Bu uyarıyı veriyor

 

[Haluk]

Su anda bilgisayar basinda degilim ama resimden gordugum kadariyla, yanlis yerlere yapistirmisiniz.

Sub Makro1 ve Sub Makro3 satirlari ile onlara ait End Sub satirlarini silin.

.

 

[mc_exrem]

Su anda bilgisayar basinda degilim ama resimden gordugum kadariyla, yanlis yerlere yapistirmisiniz.

Sub Makro1 ve Sub Makro3 satirlari ile onlara ait End Sub satirlarini silin.

.

Yapadım. dosyayı ekledim size zahmet geçince düzenleyip tekrar yükleyebilir misiniz.

 

[Haluk]

Arkadasim yapilmayacak bir sey yok.

Yeni bir Excel dosyasi ac, bu dosyaya bir tane modul ekledikten sonra 6.mesajdaki kodlari yapistir.

"Test" isimli makroyu calistir ve bahsettigin yazicinin tam adini ogren.

Sonucu bekliyorum...

.

 

[askm]

Sub Test()
    Dim myPrinter As String
    Dim printer_name As String
    myPrinter = Application.ActivePrinter
    [P1] = myPrinter
end sub

Öncelikle çıktı almak istediğiniz yazıcıyı manuel olarak varsayılan seçin. Yukarıdaki kodu çalıştırdığınızda yazıcının adını P1 hücresine yazacaktır.
Sonra normal şekilde varsayılan yazıcınızı seçin.
Aşağıdaki kodları çalıştırdığınızda çıktıyı (etiket) yazdıracağınız yazıcıdan alacak sonrasında varsayılan yazıcınız eski haline dönecektir.

Sub Test2()
    Dim myPrinter As String
    Dim printer_name As String
    Dim kopya As Long: kopya = [D6].Value


    myPrinter = Application.ActivePrinter
    [P1] = myPrinter
    MsgBox
    printer_name = "Zebra TLP2844" 'Buraya P1 e yazılı olan değeri yazıp P1 hücresinin içerisini temizleyin.
    ActiveWindow.SelectedSheets.PrintOut Copies:=kopya, Collate:=True, IgnorePrintAreas:=False
'    ActiveSheet.PrintOut Preview:=False, ActivePrinter:=printer_name
    Application.ActivePrinter = myPrinter
End Sub

 

[Haluk]

Sub Test()
    Dim myPrinter As String
    Dim printer_name As String
    myPrinter = Application.ActivePrinter
    [P1] = myPrinter
end sub

Öncelikle çıktı almak istediğiniz yazıcıyı manuel olarak varsayılan seçin. Yukarıdaki kodu çalıştırdığınızda yazıcının adını P1 hücresine yazacaktır.
Sonra normal şekilde varsayılan yazıcınızı seçin.
Aşağıdaki kodları çalıştırdığınızda çıktıyı (etiket) yazdıracağınız yazıcıdan alacak sonrasında varsayılan yazıcınız eski haline dönecektir.

Konuya dahil oldunuz ama, öneriniz zaten yukarıdaki mesajlardan farklı değil......

Söz konusu yazıcı adının "Zebra TLP2844 on Ne01:" falan gibi bir şey olması lazım....... @mc_exrem 'e bunu buldurmaya çalışıyorum ama şimdilik bir cevap yok.

.

 

[askm]

Haluk Bey size saygısızlık olsun diye müdahil olmadım. Zaten sizin kodlarınızı yazdım. Ben herhangi bir ekleme yapmadım.
Belki varsayılanı seçtirerek yazıcı adını bulabilir diye yazdım. Marka Zebra olabilir ama yazıcı ismini farklı vermiş olabilir.

 

[Haluk]

Estağfurullah, fakat mesajların tamamını okuduysanız eğer; zaten yazıcı isminin yanlış/eksik olması durumunu kontrol etmeye çalışıyordum ..... (Mesaj No:6 kodları)

.

 

[mc_exrem]

Konuya dahil oldunuz ama, öneriniz zaten yukarıdaki mesajlardan farklı değil......

Söz konusu yazıcı adının "Zebra TLP2844 on Ne01:" falan gibi bir şey olması lazım....... @mc_exrem 'e bunu buldurmaya çalışıyorum ama şimdilik bir cevap yok.

.

netten araştırdım yazıcının tam adının nasıl bulunacağına dair ama öyle bi şey bulamadım. Nasıl bulacağıma dair Yardımcı olursanız tam adını yazmış olurum. Yoğun olduğum için ancak yazabildim. anlayışınız için de teşekkürler

 

[Haluk]

Arkadaşım, yukarıda 6. mesajda verdiğim kodla söz konusu yazıcının adını bulabilmen gerekiyor .....

Kolaylık olsun diye, ekli dosyayı hazırladım. Dosyayı aç ve sayfaki butona tıkla ..... Yazıcının adını öğren.

Not: "Zebra TLP2844" yazıcısının bilgisayara bağlı ve açık olduğundan emin ol.

Daha sonra yapılacak işleri ondan sonra tarif ederim.

.

 

[mc_exrem]

Arkadaşım, yukarıda 6. mesajda verdiğim kodla söz konusu yazıcının adını bulabilmen gerekiyor .....

Kolaylık olsun diye, ekli dosyayı hazırladım. Dosyayı aç ve sayfaki butona tıkla ..... Yazıcının adını öğren.

Not: "Zebra TLP2844" yazıcısının bilgisayara bağlı ve açık olduğundan emin ol.

Daha sonra yapılacak işleri ondan sonra tarif ederim.

.

Dosyalar yüklenmemiş yalnız link pasif

 

[Haluk]

Dosyalar yüklenmemiş yalnız link pasif

Harici link:

Yazici_Adi.xlsm

.

 

[halit3]

Bu kodu bir çalıştır A sutunüna yazıcı isimlerini yazacaktır
çıkan sonuçları buraya yaz ki sizin bilgisayarınızdaki yazıcıları bilelim.

Sub yazıcılar1()
say = 2
say1 = 0
Dim oNetwork As Object, oPrinters As Object
Dim i As Single, j As Single
Dim MyPrinters As String

Set oNetwork = CreateObject("WScript.Network")
Set oPrinters = oNetwork.EnumPrinterConnections

For i = 0 To oPrinters.count - 1 Step 2
If Mid(oPrinters.Item(i), 1, 4) = "LPT1" Then
deg1 = oPrinters.Item(i)
Else
deg1 = "Ne" & Format(say1, "00") & ":"
say1 = say1 + 1
End If
Cells(say, 1) = deg1 & " üzerindeki " & oPrinters.Item(i + 1) & " "
say = say + 1

Next

End Sub

aynı şekilde benzer bir kod daha

Sub yazıcılar2()

Dim WSHNetwork
Dim objWMIService
Dim colPrinters
Dim objPrinter

Set WSHNetwork = CreateObject("WScript.Network")
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer")
For Each objPrinter In colPrinters
sat = sat + 1
Cells(sat, 1) = objPrinter.name
Next

Set WSHNetwork = Nothing
Set objWMIService = Nothing
Set colPrinters = Nothing

End Sub

 

[Haluk]

Hayret bir şey yani ....

.