Forum
Bildirimler
Hepsini Temizle
İpucu
2
Yazılar
2
Üyeler
0
Reactions
380
Görüntüleme
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.
Gönderildi : 17/11/2013 00:09
