Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

1 Temmuz 2003 Salı

Monitor Controller



'UserForm1

'Ekran Kartı bilgileri


'Add Tools on UserForm1: Label1, ListBox1, CommandButton1, Image1, Label1
Option Explicit
Dim No As Double, Sayaç As Double
Dim Eleman As Object
Dim Kontrol As Variant, Tanımı As Variant

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Information Video Kontroller..."
With ListBox1
.ColumnCount = 2
.ColumnWidths = "96;72"
End With
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
ListBox1.Clear
Call EkranKartıKontrolü
End Sub
Sub EkranKartıKontrolü()
On Error Resume Next
Set Eleman = GetObject("WinMgmts:").instancesOf("Win32_VideoController")
If (Err.Number <> 0) Then
MsgBox "WMI yüklenmemiş! Programdan çıkılacak...", vbExclamation, "Windows Management Instrumentation"
Exit Sub
On Error GoTo 0
End If
For Each Kontrol In Eleman
Sayaç = Sayaç + 1
With ListBox1
Tanımı = Kontrol.AdapterCompatibility
If Tanımı = "" Then
.AddItem Sayaç & ". " & "Üretici Firma", No: .List(No, 1) = "Disabled": No = No + 1
Else
.AddItem Sayaç & ". " & "Üretici Firma", No: .List(No, 1) = Tanımı & " (" & Kontrol.Caption & ")": No = No + 1
End If
Tanımı = Kontrol.CurrentHorizontalResolution
If VBA.Val(Tanımı) = 0 Then
.AddItem Sayaç & ". " & "Yatay çözünürlük", No: .List(No, 1) = "0": No = No + 1
Else
.AddItem Sayaç & ". " & "Yatay çözünürlük", No: .List(No, 1) = Tanımı: No = No + 1
End If
Tanımı = Kontrol.CurrentVerticalResolution
If VBA.Val(Tanımı) = 0 Then
.AddItem Sayaç & ". " & "Dikey çözünürlük", No: .List(No, 1) = "0": No = No + 1
Else
.AddItem Sayaç & ". " & "Dikey çözünürlük", No: .List(No, 1) = Tanımı: No = No + 1
End If
Tanımı = Kontrol.CurrentBitsPerPixel
If VBA.Val(Tanımı) = 0 Then
.AddItem Sayaç & ". " & "Renk kalitesi", No: .List(No, 1) = "0" & " bps": No = No + 1
Else
.AddItem Sayaç & ". " & "Renk kalitesi", No: .List(No, 1) = Tanımı & " bps": No = No + 1
End If
Tanımı = Kontrol.VideoModeDescription
If Err.Number = 94 Then
.AddItem Sayaç & ". " & "Video Modu", No: .List(No, 1) = "Disabled": No = No + 1
Else
.AddItem Sayaç & ". " & "Video Modu", No: .List(No, 1) = Tanımı: No = No + 1
End If
Tanımı = Kontrol.VideoProcessor
If VBA.Trim(Tanımı) = "" Then
.AddItem Sayaç & ". " & "İşlemci", No: .List(No, 1) = "Disabled": No = No + 1
Else
.AddItem Sayaç & ". " & "İşlemci", No: .List(No, 1) = Tanımı: No = No + 1
End If
End With
Next
End Sub

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul