Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Mart 2004 Çarşamba

UserForm AnimateWindow 01





'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
'B) UserForm1 e Eklenen Araçlar (Add Tools)
'Frame1
'Frame1\Image1, Label1, Label2
'Label3, Label4, Label5, TextBox1, textBox2, TextBox2, CommandButton1
Option Explicit
Dim Pencere As Long, dwTime As Long, dwFlag1 As Long, dwFlag2 As Long
Dim YeniUserForm As UserForm2
Dim Kontrol As Long
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD ®] UserForm AnimateWindow"
Call EkranDüzenle
End Sub
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

On Error Resume Next
If IsNumeric(TextBox1.Value) = False Then TextBox1.Value = 800
End Sub
Private Sub TextBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

On Error Resume Next
If Not VBA.Left(TextBox2.Value, 2) = "&H" Then
With TextBox2
.SelStart = 0
.SelLength = 2
.SelText = "&H"
End With
End If
End Sub
Private Sub TextBox3_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

On Error Resume Next
If Not VBA.Left(TextBox3.Value, 2) = "&H" Then
With TextBox3
.SelStart = 0
.SelLength = 2
.SelText = "&H"
End With
End If
End Sub
Private Sub CommandButton1_Click()

On Error Resume Next
Me.Hide
Set YeniUserForm = New UserForm2
With YeniUserForm
.Left = Me.Left + 6
.Top = Me.Top + 114
.Width = Me.Width - 12
.Height = Me.Height - 124
End With
Pencere = FindWindow(vbNullString, YeniUserForm.Caption)
dwTime = TextBox1.Value
dwFlag1 = TextBox2.Value
dwFlag2 = TextBox3.Value
Kontrol = AnimateWindow(Pencere, dwTime, dwFlag1 Or dwFlag2)
If Kontrol = 0 Then Me.Show
YeniUserForm.Repaint
Exit Sub
End Sub
Sub EkranDüzenle()

On Error Resume Next
With Me
.Height = 282
.Width = 306
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 Label3
.Caption = "dwTime"
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 36
.Height = 12
.Width = 96
.ForeColor = &H404000
.TextAlign = fmTextAlignCenter
End With
With TextBox1
.Value = 800
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 48
.Height = 18
.Width = 96
.Font.Bold = True
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
End With
With Label4
.Caption = "dwFlag1"
.SpecialEffect = fmSpecialEffectEtched
.Left = 102
.Top = 36
.Height = 12
.Width = 96
.ForeColor = &H404000
.TextAlign = fmTextAlignCenter
End With
With TextBox2
.Value = "&H4"
.SpecialEffect = fmSpecialEffectEtched
.Left = 102
.Top = 48
.Height = 18
.Width = 96
.Font.Bold = True
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
End With
With Label5
.Caption = "dwFlag2"
.SpecialEffect = fmSpecialEffectEtched
.Left = 198
.Top = 36
.Height = 12
.Width = 96
.ForeColor = &H404000
.TextAlign = fmTextAlignCenter
End With
With TextBox3
.Value = "&H60000"
.SpecialEffect = fmSpecialEffectEtched
.Left = 198
.Top = 48
.Height = 18
.Width = 96
.Font.Bold = True
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
End With
With CommandButton1
.Left = 6
.Top = 72
.Height = 18
.Width = 288
.Caption = "UserForm2 Window Animate"
End With
End With
End Sub

'UserForm2

Option Explicit
Private Sub UserForm_Activate()

On Error Resume Next
Me.Caption = "UserForm2 Animated Flags= " & UserForm1.TextBox2.Value & "-" & UserForm1.TextBox3.Value
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

On Error Resume Next
Cancel = True
AnimateWindow FindWindow(vbNullString, Me.Caption), 800, &H80000 Or &H10000
UserForm1.Show
End Sub

'Module1

Option Explicit
Public Declare Function AnimateWindow Lib "user32" (ByVal hWnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Sub ÖrnekAnimateWindow()
'AnimateWindow Example

On Error Resume Next
UserForm1.Show 0
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