Bilgisayara Bağlı Yazıcıların Özellikleri

Konu başlatıcı

Bilgisayarınıza bağlı olan yazıcıların özelliklerini bu kodlarla öğrenebilirsiniz;

■ Alternatif - 1
Sub Yazıcıların_Özellikleri()
    Dim Name As Object, Item As Object, Con As Object, Drv As Object
    Dim i As Integer, a As Integer, e As Integer
    Set Name = GetObject("winmgmts:").instancesof("Win32_Printer")
    Set Con = GetObject("winmgmts:").instancesof("Win32_PrinterConfiguration")
    Set Drv = GetObject("winmgmts:").instancesof("Win32_PrinterDriver")
    Range("A2:Q10").ClearContents
    i = 2: a = 2: e = 2
    For Each Item In Name
        Cells(i, 1) = Item.DeviceID
        Cells(i, 2) = Item.portname
        Cells(i, 3) = Item.ServerName
        Cells(i, 4) = Item.CreationClassName
        Cells(i, 5) = Item.Default
        Cells(i, 6) = Item.Attributes
        Cells(i, 7) = Item.HorizontalResolution
        Cells(i, 8) = Item.VerticalResolution
        Cells(i, 9) = Item.Shared
        Cells(i, 10) = Item.ShareName
        Cells(i, 11) = Item.SystemName
        Cells(i, 12) = Item.PrintProcessor
        If IsNull(Item.CapabilityDescriptions) Then
            Cells(i, 13) = ""
                Else
            Cells(i, 13) = Join(Item.CapabilityDescriptions, ",")
        End If
        i = i + 1
    Next Item
    For Each Item In Con
        Cells(a, 14) = Item.FormName
        Cells(a, 15) = Item.PaperSize
        a = a + 1
    Next Item
    For Each Item In Drv
        Cells(e, 16) = Item.configfile
        Cells(e, 17) = Item.SupportedPlatform
        e = e + 1
    Next Item
    Columns.AutoFit
    Set Name = Nothing: Set Item = Nothing: Set Con = Nothing
    Set Drv = Nothing: i = Empty: a = Empty: e = Empty
End Sub

■ Alternatif - 2

Sub Yazıcıların_Özellikleri()
    Dim Name As Object, Items As Object, Item As Object
    Dim i As Byte
    On Error Resume Next
    Set Name = GetObject("winmgmts:").instancesof("Win32_PrinterConfiguration")
    For Each Item In Name
        i = i + 1
        Cells(1, i) = "BitsPerPel: " & Item.BitsPerPel
        Cells(2, i) = "Caption: " & Item.Caption
        Cells(3, i) = "Collate: " & Item.Collate
        Cells(4, i) = "Color: " & Item.Color
        Cells(5, i) = "Copies: " & Item.Copies
        Cells(6, i) = "Description: " & Item.Description
        Cells(7, i) = "DeviceName: " & Item.DeviceName
        Cells(8, i) = "DisplayFlags: " & Item.DisplayFlags
        Cells(9, i) = "DisplayFrequency: " & Item.DisplayFrequency
        Cells(10, i) = "DitherType: " & Item.DitherType
        Cells(11, i) = "DriverVersion: " & Item.DriverVersion
        Cells(12, i) = "Duplex: " & Item.Duplex
        Cells(13, i) = "FormName: " & Item.FormName
        Cells(14, i) = "HorizontalResolution: " & Item.HorizontalResolution
        Cells(15, i) = "ICMIntent: " & Item.ICMIntent
        Cells(16, i) = "ICMMethod: " & Item.ICMMethod
        Cells(17, i) = "LogPixels: " & Item.LogPixels
        Cells(18, i) = "MediaType: " & Item.MediaType
        Cells(19, i) = "Name: " & Item.Name
        Cells(20, i) = "Orientation: " & Item.Orientation
        Cells(21, i) = "PaperLength: " & Item.PaperLength
        Cells(22, i) = "PaperSize: " & Item.PaperSize
        Cells(23, i) = "PaperWidth: " & Item.PaperWidth
        Cells(24, i) = "PelsHeight: " & Item.PelsHeight
        Cells(25, i) = "PelsWidth: " & Item.PelsWidth
        Cells(26, i) = "PrintQuality: " & Item.PrintQuality
        Cells(27, i) = "Scale: " & Item.Scale
        Cells(28, i) = "SettingID: " & Item.SettingID
        Cells(29, i) = "SpecificationVersion: " & Item.SpecificationVersion
        Cells(30, i) = "TTOption: " & Item.TTOption
        Cells(31, i) = "VerticalResolution: " & Item.VerticalResolution
        Cells(32, i) = "XResolution: " & Item.XResolution
        Cells(33, i) = "YResolution: " & Item.YResolution
        Columns(i).AutoFit
    Next Item
    Set Name = Nothing: Set Items = Nothing: Set Item = Nothing: i = Empty

End Sub

Hoşça kalın ! --)(

Gönderildi : 16/11/2013 15:34

Teşekkürler.

1984 doğumluyum. 4 yaşından bu yana İstanbul’da yaşıyorum. Sırası ile aşağıdaki okullarda eğitim gördüm. Paşaköy ilkokulu (1990-1995) Kartal Zekeriyya Güçer İlköğretim Okulu(1995-1998) Ümraniye Teknik ve Endüstri Meslek Lisesi Bilgisayar Bölümü(1998-2001) Kocaeli Üniversitesi Bilgisayar Programcılığı(2002-2004) Anadolu Ünv. İşletme Fakültesi(2006-2009) Lise yıllarından sonra bir bilgisayar firmasının teknik servisinde mesleğe merhaba dedim. Outsource olarak Citibank ytl ve bina taşınma projesinde yer alarak 8 ay görev yaptım. Bu görevden sonra şu an çalışmakta olduğum yerde bilgi işlem sorumlusu olarak göreve başladım ve 18 yıldır görevimin başındayım.