Yazıcıların listesi

[Ertan83]

Sub a()
  Debug.Print Application.ActivePrinter
End Sub

komutu ile aktif yazıcının hangisi olduğunu öğrenebiliyoruz. Peki diğer yazıcıların hangileri olduğunu öğrenebilirmiyiz? (Not:

Sub b()
  Application.Dialogs(xlDialogPrinterSetup).Show
  Application.Dialogs(xlDialogPrint).Show
End Sub

bunlar ile olmayacak.

Ayrıca cevabını alamadığım bir sorum daha vardı:

25-30 sayfa arasında değişen sayfalarımın sayfa Yapıları (Yazıcı Ayarları)ile ilgili değişkliker yaptım, yazdırma alanları, üst bilgiler, kenarlıklar v.b. onlarca işlem. Þimdi bu işlemlerden vazgeçmek ve ayarları ilk haline geri getirmek için ne yapmam gerekir? Teşekkürler.

 

[Haluk]

....
Peki diğer yazıcıların hangileri olduğunu öğrenebilirmiyiz?
....

 Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
 Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Long) As Long
 Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal flags As Long, ByVal name As String, ByVal Level As Long, pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
 Const PRINTER_ENUM_LOCAL = &H2
 Type PRINTER_INFO_1
        flags As Long
        pDescription As String
        pName As String
        pComment As String
End Type
'
Sub ListPrinters()
    Dim longbuffer() As Long
    Dim printinfo() As PRINTER_INFO_1
    Dim numbytes As Long
    Dim numneeded As Long
    Dim numprinters As Long
    Dim c As Integer, retval As Long
    Dim MyPrinters As String
    
    numbytes = 3076
    ReDim longbuffer(0 To numbytes / 4) As Long
    retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, _
            longbuffer(0), numbytes, numneeded, numprinters)
    If retval = 0 Then
        numbytes = numneeded
        ReDim longbuffer(0 To numbytes / 4) As Long
        retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, _
            longbuffer(0), numbytes, numneeded, numprinters)
                If retval = 0 Then
                     MsgBox "Could not successfully enumerate the printes."
                    End
                End If
    End If
    If numprinters <> 0 Then _
    ReDim printinfo(0 To numprinters - 1) As PRINTER_INFO_1
For c = 0 To numprinters - 1
    printinfo(c).flags = longbuffer(4 * c)
    printinfo(c).pDescription = _
    Space(lstrlen(longbuffer(4 * c + 1)))
    retval = lstrcpy(printinfo(c).pDescription, longbuffer(4 * c + 1))
    printinfo(c).pName = Space(lstrlen(longbuffer(4 * c + 2)))
    retval = lstrcpy(printinfo(c).pName, longbuffer(4 * c + 2))
    printinfo(c).pComment = Space(lstrlen(longbuffer(4 * c + 3)))
    retval = lstrcpy(printinfo(c).pComment, longbuffer(4 * c + 3))
Next c
    For c = 0 To numprinters - 1
        MyPrinters = MyPrinters & "Printer" & c + 1 & " = " _
                    & printinfo(c).pName & vbCrLf
    Next c
    MsgBox "Available printers: " & vbCrLf & vbCrLf & MyPrinters
End Sub

Veya, WMI kullanarak ...

Sub PrinterInfo()
'Raider ®
    Dim PrinterList As String, oSystem As Object, oPrinter As Object
    Dim i As Single
    '
    Set oSystem = GetObject("winmgmts:").instancesOf("Win32_Printer")
    '
    PrinterList = "Mevcut Printer'lar:" & vbCrLf
    PrinterList = PrinterList & "-----------------------" & vbCrLf
    For Each oPrinter In oSystem
        PrinterList = PrinterList & "Printer" & i + 1 & " = " & oPrinter.Name & vbCrLf
        i = i + 1
    Next
    MsgBox PrinterList, vbInformation, "Rapor !"
    Set oSystem = Nothing
End Sub

 

[mami6264]

Teşekkürler. bilgi için, Benim ayrıca bir sorum olacak,
ilgili yazıcı listesine yazıcının hangi port ta olduğunu da ekleyebilir miyiz.
şimdiden yardımlarınız için teşekkürler.

 

[Levent Menteşoğlu]

WMI ile elde edilen çözümde oPrinter.Name yerine oPrinter.Portname yazarak istediğiniz sonucu elde edeiblirsiniz.

 

[mami6264]

Levent Bey, Teşekkürler.
Port Name olarak size yanlış ifade etmiş olabilirim. Benim ulaşmak istediğim. Macro kayıtın yazdığı,
"Application.ActivePrinter="Döküman on NE05"
Kodundaki "NE05" bilgisine ulaşmak,
Sonrasında da, Kullanıcı printer bilgisini seçerek, sürekli o printer üzerinden döküman yazdırmasını sağlamak.

ikinci olarak ta; Printer Name, ve Port bilgisine ulaştıktan sonra, aşağıdaki kodu yazıyorum. bana
"Application.defined or object-defined error" hatası veriyor. bu bilgiyi nasıl kullanabilirim.

Application.ActivePrinter = data.Range(Set2) & " on " & data.Range(Set2_1) & ":"
ActiveWindow.SelectedSheets.PrintOut Copies:=2

 

[mancubus]

benim durumunda server'a bağlı olduğu için her defasında makro kaydedici ile buluyorum NeXX'teki XX'i. sürekli değişiyor çünkü.

ikinci sorunuz.
Application.ActivePrinter = "\\xxxxxx\PRTyyyy on Ne06:"
çift tırnak olduğuna dikkat ediniz.

şöyle olabilir belki:
"data.Range(Set2).Text & " on " & data.Range(Set2_1).Text & ":""

 

[mancubus]

not: "data" Worksheet olarak tanımlanmış bir değişken değil mi?
(Dim data As Worksheet)

 

[mami6264]

evet. Deneyeceğim. tşk.

 

[mami6264]

Dim b As Sheet1
Dim ba As Sheet2
Dim data As Sheet3


Set b = Sheets("Bag")
Set ba = Sheets("Basım")
Set data = Sheets("Data")

Application.ScreenUpdating = False
Sheets("form1").Visible = True
Sheets("Data").Visible = True
Sheets("Data").Range("AK2").Value = ""
If ba.Range("B24") = "FO6TU" Or ba.Range("B24") = "HHOTU" Then
Sheets("Data").Range("AK2").Value = ba.Range("C34").Value
End If
soru = MsgBox("İRSALİYe Basılsın mı?", vbYesNo + vbQuestion, "Soru")
If soru = vbYes Then
Sheets("form1").Select
Application.Dialogs(xlDialogPrint).Show
' ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
' data.Range(Set1) & " on " & data.Range(Set1_1) & ":", Collate:=True

Sheets("form1").Visible = False
End If
soru = MsgBox("EPDK sı Basılsın mı?", vbYesNo + vbQuestion, "Soru")
If soru = vbYes Then
Sheets("EPDKForm").Visible = True
Sheets("EPDKForm").Select
'Application.Dialogs(xlDialogPrint).Show
Application.ActivePrinter = data.Range(Set2).Text & " on " & data.Range(Set2_1).Text & ":"
ActiveWindow.SelectedSheets.PrintOut Copies:=2
Sheets("EPDKForm").Visible = False
End If

Kodun tamamanı yazdım. yine aynı hatayı alıyorum.

 

[mancubus]

aşağıdaki gibi bir KTF buldum.

kodu kopyaladıktan sonra printer ismi ile denediğinizde tam printer ismini veriyor.

=FindPrinter("Printer_İsmi")

bu formül ile gelen değerin sağdan 5 karakterini aldığınızda

=Right(FindPrinter("Printer_İsmi"),5)

Ne05:
gibi bir değer elde ediyorsunuz.

bunu bir değişkene atayarak;
dim nexx As String
nexx = Right(FindPrinter("Printer_İsmi"),5)

(MsgBox nexx satırı ile test edin)

aşağıdaki kodunuzu değiştirirseniz, (bir uzmanımız yardım ederse doğruyu bulabiliriz)

ActiveSheet.PrintOut Copies:=1, ActivePrinter:= _
data.Range(Set1) & " on " & nexx, Collate:=True

"data.Range(Set1) &" bölümünün düznlenmesi lazım..
belki de bir mantık hatası yapıyoruz.

iyi günler...

'Written: November 28, 2009
'Author:  Leith Ross
'Summary: Finds a printer by name and returns the printer name and port number.

Function FindPrinter(ByVal PrinterName As String) As String
'http://www.excelforum.com/excel-programming/708921-printer-selection-problem-due-to-ne-port-numbering.html
 'This works with Windows 2000 and up
 
  Dim Arr As Variant
  Dim Device As Variant
  Dim Devices As Variant
  Dim Printer As String
  Dim RegObj As Object
  Dim RegValue As String
  Const HKEY_CURRENT_USER = &H80000001
       
    Set RegObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    RegObj.enumvalues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Devices, Arr
    
      For Each Device In Devices
        RegObj.getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Device, RegValue
        Printer = Device & " on " & Split(RegValue, ",")(1)
        If InStr(1, Printer, PrinterName, vbTextCompare) > 0 Then
           FindPrinter = Printer
           Exit Function
        End If
      Next
      
End Function

 

[mami6264]

Teşekkürler. verginiz kod ile ikinci değeri de elde ettim. fakat her ne yaptıysam, kodu çalıştıramadım. Application.ActivePrinter = data.Range(Set2).Text & " on " & data.Range(Set2_1).Text & ":

Application.activePrinter= "Değerinde Printer ismini tamamlıyorum." Şöyle yazıyor. "Döküman on NE05:" fakat bu değer hata veriyor.

 

[mancubus]

FindPrinter KTF'nu kullanmak kaydı ile aşağıdaki gibi bir kod benim için çalıştı.

C4 (veya belirleyeceğiniz başka bir hücre veya isimlendirilmiş hücre) hücresinde "HP Officejet J6400 series" vb bir Printer_İsmi yazılı olmak kaydı ile

MyPrinter = FindPrinter("C4")
MyPrinter = ActivePrinter
ActiveWindow.SelectedSheets.PrintOut Copies:=1

not: sizin örneğe uyarlayacak olur isek

MyPrinter = FindPrinter("Set2")

 

[mami6264]

İlginize Teşekkürler, Bu sefer oldu.

 

[mancubus]

rica ederim.
arada bir kontrol edin yine de, portların değişmesini dikkate alarak.