Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

1 Haziran 2012 Cuma

Enumerate Windows Styles [2]

'UserForm1

'A. Available References List
'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
'6) Name: MSComctlLib, Description: Microsoft Windows Common Controls 6.0 (SP6), FullPath: C:\Windows\SysWOW64\MSCOMCTL.OCX
'B. Available Tools List
'1) İmage1, Label1, Label2
'2) Label3, ListView1
'3) CommandButton1, CommandButton2, Label4
Option Explicit
Private No As Long
Private sWind As Long
Private Durum As Boolean
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Enumerate Windows Styles [2]"
Application.Visible = False
Call Ekran_Kur
End Sub
Private Sub UserForm_Terminate()
On Error Resume Next
Application.Visible = True
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
Label1.Caption = FindWindow(vbNullString, Me.Caption)
ListView1.ListItems.Clear
No = 1
Call Enumeration_Window(0)
End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
If Durum = False Then
StartButtonState sWind, False 'Hide the enumerated window        
Durum = True
CommandButton2.Caption = "Show Window"
Else
StartButtonState sWind, True 'Show the enumerated window        
Durum = False
CommandButton2.Caption = "Hidden Window"
End If
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
On Error Resume Next
sWind = Item.Text
Label4.Caption = " wLong; " & sWind & ", wClass; " & Item.SubItems(1) & ", wTitle; " & Item.SubItems(2)
If sWind <> 0 Then
CommandButton2.Enabled = True
Else
CommandButton2.Enabled = False
End If
End Sub
Private Sub Enumeration_Window(pWind As Long)
On Error Resume Next
Dim hWind As Long
Dim hLong As Long
Dim hText As String
hWind = FindWindowEx(pWind, 0&, vbNullString, vbNullString)
While hWind <> 0
ListView1.ListItems.Add No, , hWind 'Handle        
hText = VBA.String$(255, VBA.Chr$(0))
hLong = GetClassName(hWind, hText, 255)
hText = VBA.Left$(hText, hLong)
ListView1.ListItems(No).SubItems(1) = hText
If hLong > 0 Then
ListView1.ListItems(No).SubItems(2) = hText 'Class Name
Else
ListView1.ListItems(No).SubItems(2) = "N/A"
End If
hText = VBA.String$(255, VBA.Chr$(0))
hLong = GetWindowText(hWind, hText, 255)
hText = VBA.Left$(hText, hLong)
If hLong > 0 Then
ListView1.ListItems(No).SubItems(2) = hText 'Title
Else
ListView1.ListItems(No).SubItems(2) = "N/A"
End If
No = No + 1
hWind = FindWindowEx(pWind, hWind, vbNullString, vbNullString)
DoEvents
Wend
End Sub
Private Sub StartButtonState(sWind As Long, hDurum As Boolean)
On Error Resume Next
Select Case hDurum
Case "True": ShowWindow sWind&, 1
Case "False": ShowWindow sWind&, 2
End Select
End Sub
Private Sub Ekran_Kur()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 340
.Width = 570
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
.SpecialEffect = fmSpecialEffectFlat
With Image1
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.BorderColor = vbBlue
.Picture = Resim(URL2)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Label1
.Left = 36
.Top = 6
.Height = 12
.Width = 420
.Caption = "Mustafa ULUSARAÇ"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label2
.Left = 36
.Top = 18
.Height = 12
.Width = 420
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label3
.Left = 6
.Top = 36
.Height = 18
.Width = 554
.Caption = "Enumerated Windows"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With ListView1
.Left = 6
.Top = 54
.Height = 228
.Width = 554
.Appearance = ccFlat
.BackColor = &HE0E0E0
.ForeColor = &H404000
.BorderStyle = ccNone
.ColumnHeaders.Add 1, , "Window Long", 60
.ColumnHeaders.Add 2, , "Window Class Name", 240
.ColumnHeaders.Add 3, , "window Title", 240
.FlatScrollBar = False
.FullRowSelect = True
.Gridlines = True
.LabelEdit = lvwManual
.View = lvwReport
End With
With CommandButton1
.Left = 6
.Top = 288
.Height = 24
.Width = 114
.Caption = "Enumeration Window"
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With CommandButton2
.Left = 126
.Top = 288
.Height = 24
.Width = 114
.Caption = "Hidden Window"
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.Enabled = False
End With
With Label4
.Left = 246
.Top = 288
.Height = 24
.Width = 312
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
End With
End Sub

'Module1

Option Explicit
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Public Const URL1 As String = "http://2.bp.blogspot.com/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp"
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg"
Public URL As String
Sub Form_Aç()
On Error Resume Next
UserForm1.Show 0
End Sub
Public Function Resim(URL) As Picture 'Picture load frome web address...
On Error Resume Next
CLSIDFromString StrPtr(ClsID), IPic(0)
OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim
End Function
'Sub References_List()
'On Error Resume Next
'Dim Eleman, No
'No = 1
'For Each Eleman In ThisWorkbook.VBProject.References
'Sheets(1).Cells(No, 1) = No & ") Name: "
'Sheets(1).Cells(No, 2) = Eleman.Name
'Sheets(1).Cells(No, 3) = ", Description: "
'Sheets(1).Cells(No, 4) = Eleman.Description
'Sheets(1).Cells(No, 5) = ", FullPath: "
'Sheets(1).Cells(No, 6) = Eleman.FullPath
'No = No + 1
'Next Eleman
'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