Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

1 Mart 2012 Perşembe

GetWindowRect Function


'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
'B. Available Tools List
'1) İmage1, Label1, Label2
'2) Label3, Label4, Label5, Label6, Label7, Label8
'3) Label9, Label10, Label11, Label12, Label13, Label14
'4) Label15, Label16, Label17, Label18, Label19, Label20
'5) Label21, Label22, Label23
'6) CommandButton1, Image2, Image3
Option Explicit
Private Type Rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal ClassName As String, ByVal WindowName As String) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, Rect As Rect) As Long
Private hWind As Long
Private hRect As Rect
Private hRate As Double
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] GetWindowRect Function"
Call Ekran_Kur
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
hWind = FindWindow("XLMAIN", Application.Caption)
If hWind > 0 Then
Call GetWindowRect(hWind, hRect)
Label9.Caption = hRect.Left
Label10.Caption = hRect.Right
Label11.Caption = hRect.Top
Label12.Caption = hRect.Bottom
Label13.Caption = (hRect.Right - hRect.Left)
Label14.Caption = (hRect.Bottom - hRect.Top)
End If
hWind = FindWindow(vbNullString, Me.Caption)
If hWind > 0 Then
Call GetWindowRect(hWind, hRect)
Label15.Caption = hRect.Left
Label16.Caption = hRect.Right
Label17.Caption = hRect.Top
Label18.Caption = hRect.Bottom
Label19.Caption = (hRect.Right - hRect.Left)
Label20.Caption = (hRect.Bottom - hRect.Top)
End If
With Image3
hRate = (Label20.Caption / Label14.Caption) * (Image2.Height / Label20.Caption)
.Height = (hRect.Bottom - hRect.Top) * hRate
hRate = (Label19.Caption / Label13.Caption) * (Image2.Width / Label19.Caption)
.Width = (hRect.Right - hRect.Left) * hRate
hRate = Label17.Caption / Label14.Caption
.Top = Image2.Top + Image2.Height * hRate
hRate = Label15.Caption / Label13.Caption
.Left = Image2.Left + Image2.Width * hRate
End With
End Sub
Private Sub Ekran_Kur()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 214
.Width = 390
.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 = 240
.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 = 240
.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 = 48
.Height = 18
.Width = 36
.Caption = " Left"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label4
.Left = 6
.Top = 66
.Height = 18
.Width = 36
.Caption = " Right"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label5
.Left = 6
.Top = 84
.Height = 18
.Width = 36
.Caption = " Top"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label6
.Left = 6
.Top = 102
.Height = 18
.Width = 36
.Caption = " Bottom"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label7
.Left = 6
.Top = 120
.Height = 18
.Width = 36
.Caption = " Width"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label8
.Left = 6
.Top = 138
.Height = 18
.Width = 36
.Caption = " Height"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label9
.Left = 42
.Top = 48
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.Font.Bold = True
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label10
.Left = 42
.Top = 66
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.Font.Bold = True
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label11
.Left = 42
.Top = 84
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.Font.Bold = True
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label12
.Left = 42
.Top = 102
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.Font.Bold = True
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label13
.Left = 42
.Top = 120
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.Font.Bold = True
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label14
.Left = 42
.Top = 138
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.Font.Bold = True
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label15
.Left = 108
.Top = 48
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.Font.Bold = True
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label16
.Left = 108
.Top = 66
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.Font.Bold = True
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label17
.Left = 108
.Top = 84
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.Font.Bold = True
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label18
.Left = 108
.Top = 102
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.Font.Bold = True
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label19
.Left = 108
.Top = 120
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.Font.Bold = True
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label20
.Left = 108
.Top = 138
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.Font.Bold = True
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label21
.Left = 6
.Top = 36
.Height = 12
.Width = 36
.Caption = "Size"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label22
.Left = 42
.Top = 36
.Height = 12
.Width = 66
.Caption = "Excel"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label23
.Left = 108
.Top = 36
.Height = 12
.Width = 66
.Caption = "UserForm"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Image2
.Left = 180
.Top = 36
.Height = 150
.Width = 198
.BorderStyle = fmBorderStyleNone
.BackStyle = fmBackStyleOpaque
.BackColor = &H80FF80
.SpecialEffect = fmSpecialEffectFlat
End With
With Image3
.Left = 228
.Top = 84
.Height = 60
.Width = 102
.BorderStyle = fmBorderStyleNone
.BackStyle = fmBackStyleOpaque
.BackColor = &H80FF80
.SpecialEffect = fmSpecialEffectFlat
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
End With
With CommandButton1
.Left = 6
.Top = 162
.Height = 24
.Width = 168
.BackStyle = fmBackStyleTransparent
.Caption = "GetWindowRect"
.Font.Bold = True
.ForeColor = &H808000
End With
End With
End Sub
Private Sub UserForm_Layout()
On Error Resume Next
Call CommandButton1_Click
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ç() 'Open UserForm
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