Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Mart 2004 Cumartesi

UserForm AnimateWindow 02





'UserForm1

'A) Windows XP® Office 2003® Normal Referance List

'Visual Basic For Aplication
'Microsoft Forms 2.0 Object Library
'Microsoft Excel 11.0 Object Library
'OLE Automation
'Microsoft Office 11.0 Object Library
'Microsoft Internet Controls
'B) UserForm1 E Eklenen Araçlar (Add Tools)
'Frame1
'Frame1\Image1, Label1, Label2
'WebBrowser1, TextBox1
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub SetWindowPos Lib "user32" (ByVal Pencere As Long, ByVal PencereInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Declare Function GetWindowRect Lib "user32" (ByVal Pencere As Long, lpRect As Dörtgen) As Long
Private Declare Function AnimateWindow Lib "user32" (ByVal Pencere As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Private Type Koordinat

X As Long
Y As Long
End Type
Private Type Dörtgen

Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Boyut As Dörtgen
Private Const MEkran = 0
Private Const MSistem = 1
Private Const EPozisyon& = &H1
Private Pencere As Long
Private AEn As Integer, ABoy As Integer, EEn As Integer, EBoy As Integer, ESol As Integer, EÜst As Integer
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD ®] UserForm AnimateWindow 02"
Call EkranDüzenle
Call NetAç
Call HtmlKod
End Sub
Sub EkranDüzenle()

On Error Resume Next
With Me
.Height = 254
.Width = 528
.BackColor = &H8000000F
With Frame1
.Top = -2
.Left = -2
.Height = 36
.Width = Me.Width + 12
If .Picture = vbNull Then .Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\zarifVİSTA.bmp")
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
With Image1
.BackStyle = fmBackStyleTransparent
.BorderColor = &HFF0000
.BorderStyle = fmBorderStyleSingle
.Top = 6
.Left = 6
.Height = 24
.Width = 24
If .Picture = vbNull Then .Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\Örnekİkonlar\PBİD.ico")
End With
With Label1
.Caption = " " & "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 6
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = &HFF0000
End With
With Label2
.Caption = " " & "01ulusarac@superonline.com"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 18
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = &HFF0000
End With
End With
With WebBrowser1
.Left = 6
.Top = 42
.Height = 156
.Width = 510
.Navigate "About:Blank"
Do While .Busy
DoEvents
Loop
DoEvents
End With
With TextBox1
.Left = 6
.Top = 204
.Height = 18
.Width = 510
.Text = "[PBİD®] UserForm Animate Mustafa ULUSARAÇ 01ulusarac@superonline.com"
.Font.Bold = True
.ForeColor = vbBlue
End With
End With
End Sub
Sub NetAç()
'NetShow

On Error Resume Next
With WebBrowser1
.Document.Open
End With
AEn = GetSystemMetrics32(MEkran)
ABoy = GetSystemMetrics32(MSistem)
Pencere = FindWindow(vbNullString, Me.Caption)
GetWindowRect Pencere, Boyut
EEn = VBA.Abs(Boyut.Right - Boyut.Left)
EBoy = VBA.Abs(Boyut.Top - Boyut.Bottom)
ESol = (AEn - EEn) / 2
EÜst = (ABoy - EBoy) / 2
SetWindowPos Pencere, 0&, ESol, EÜst, 0&, 0&, EPozisyon
AnimateWindow Pencere, 800, &H10 Or &H20000
Me.Repaint
End Sub
Sub HtmlKod() 'HtmlCode

On Error Resume Next
'HtmlCode is in the Code Picture(1)
End Sub

'Module1

Option Explicit
Sub FormAç()

On Error Resume Next
Load UserForm1
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