Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

1 Nisan 2007 Pazar

Useful UserForm1





'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)
'Frama1
'Frame1\Image1, Label1, Label2
'CommandButton1, CommandButton2, CommandButton3
'Slider1
Option Explicit
Dim ÇerçeveDüzenleme As New Class1
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD ®]"
Call EkranDüzenle
Application.Visible = False
Application.VBE.MainWindow.Visible = False
Set ÇerçeveDüzenleme.LogoYerleştir = Me
Set ÇerçeveDüzenleme.Form1 = Me
End Sub
Private Sub UserForm_Activate()

On Error Resume Next
With Me
.Top = (Application.Height - .Height) / 2
.Left = (Application.Width - .Width) / 2
End With
End Sub
Private Sub UserForm_Resize()

On Error Resume Next
With Me
.Top = (Application.Height - .Height) / 2
.Left = (Application.Width - .Width) / 2
End With
Call EkranDüzenle
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

On Error Resume Next
Application.Visible = True
End
End Sub
Private Sub Slider1_Change()

On Error Resume Next
Set ÇerçeveDüzenleme.FormManuelYokol = Me
End Sub
Private Sub CommandButton1_Click()

On Error Resume Next
Set ÇerçeveDüzenleme.KapatEtkisiz = UserForm1
End Sub
Private Sub CommandButton2_Click()

On Error Resume Next
Set ÇerçeveDüzenleme.KapatEtkili = UserForm1
End Sub
Private Sub CommandButton3_Click()

On Error Resume Next
Kapat
End Sub
Sub Kapat()

Set ÇerçeveDüzenleme.FormYokol = Me
Unload Me
Application.Visible = True
ActiveWorkbook.Save
'Application.Quit
End Sub
Sub EkranDüzenle()

On Error Resume Next
With Me
.Height = 312
.Width = 498
.BackColor = &H8000000F
With Frame1
.Top = -2
.Left = -2
.Height = 36
.Width = Me.Width + 12
.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
.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 CommandButton1
.Top = 264
.Left = 366
.Height = 18
.Width = 36
.Caption = "[X] Off"
.ForeColor = VBA.vbRed
.Font.Bold = True
End With
With CommandButton2
.Top = 264
.Left = 408
.Height = 18
.Width = 36
.Caption = "[X] On"
.ForeColor = VBA.vbGreen
.Font.Bold = True
End With
With CommandButton3
.Top = 264
.Left = 450
.Height = 18
.Width = 36
.Caption = "Close"
.ForeColor = VBA.vbBlack
.Font.Bold = True
End With
With Slider1
.Top = 234
.Left = 6
.Height = 30
.Width = 480
.Min = 0
.Max = 255
.SmallChange = 1
.LargeChange = 1
.SelectRange = True
.TickStyle = sldNoTicks
.Value = 0
End With
End With
End Sub

'Module1

Option Explicit
Sub Auto_Open()

On Error Resume Next
Workbooks("Kitap1").Close False
Workbooks("Book1").Close False
Load UserForm1
End Sub

'Class1

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal Class_Adı As String, ByVal Ekran_Adı As String) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal Class_Adı As String, ByVal Ekran_Adı As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Pencere As Long, ByVal Koordinat As Long) As Long
Private Declare Function GetWindowLongA Lib "user32" (ByVal Pencere_Düzeni As Long, ByVal Koordinat As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Pencere_Düzeni As Long, ByVal Koordinat As Long, ByVal Yeni_Boyut As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal Pencere As Long, ByVal Koordinat As Long, ByVal Yeni_Boyut As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal Pencere As Long, ByVal Eylem As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal Pencere As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal Pencere As Long, ByVal Anahtar As Long, ByVal Yoğunluk As Byte, ByVal İkinci_İşaret As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal Pencere As Long, ByVal Eski_Durum As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal FormMenü As Long, ByVal Pozisyon As Long, ByVal İlk_İşaret As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Pencere_Düzeni As Long, ByVal Mesaj As Long, ByVal Değişken1 As Long, Değişken2 As Any) As Long
Dim Çerçeve As Long, Tarz As Long, Logo As Long
Dim i As Integer, Derece As Double
Public Property Set LogoYerleştir(Form As Object)

On Error Resume Next
Logo = Form.Image1.Picture.Handle
Çerçeve = FindWindow(vbNullString, Form.Caption)
Call SendMessage(Çerçeve, &H80, 0&, ByVal Logo)
Call SendMessage(Çerçeve, &H80, 1&, ByVal Logo)
End Property
Public Property Set Form1(Form As Object)

On Error Resume Next
Çerçeve = FindWindow(vbNullString, Form.Caption)
Tarz = GetWindowLong(Çerçeve, (-16)) Or &H80000 Or &H20000 Or &H10000
SetWindowLong Çerçeve, (-16), Tarz
ShowWindow Çerçeve, 5 '3
DrawMenuBar Çerçeve
End Property
Public Property Set FormGörün(Form As Object)

On Error Resume Next
For i = 1 To 255
SetWindowLong Çerçeve, (-20), GetWindowLong(Çerçeve, (-20)) Or &H80000
SetLayeredWindowAttributes Çerçeve, 0, i, &H2
Çerçeve = FindWindow(vbNullString, Form.Caption)
Tarz = GetWindowLong(Çerçeve, (-16)) Or &H80000 Or &H20000 Or &H10000
SetWindowLong Çerçeve, (-16), Tarz
ShowWindow Çerçeve, 5 '3
DrawMenuBar Çerçeve
DoEvents
Next i
End Property
Public Property Set FormYokol(Form As Object)

On Error Resume Next
For i = 1 To 255
SetWindowLong Çerçeve, (-20), GetWindowLong(Çerçeve, (-20)) Or &H80000
SetLayeredWindowAttributes Çerçeve, 0, (255 - i), &H2
Çerçeve = FindWindow(vbNullString, Form.Caption)
Tarz = GetWindowLong(Çerçeve, (-16)) Or &H80000 Or &H20000 Or &H10000
SetWindowLong Çerçeve, (-16), Tarz
ShowWindow Çerçeve, 5 '3
DrawMenuBar Çerçeve
DoEvents
Next i
End Property
Public Property Set FormManuelYokol(Form As Object)

On Error Resume Next
Derece = Form.Slider1.Value
SetWindowLong Çerçeve, (-20), GetWindowLong(Çerçeve, (-20)) Or &H80000
SetLayeredWindowAttributes Çerçeve, 0, (255 - Derece), &H2
Çerçeve = FindWindow(vbNullString, Form.Caption)
Tarz = GetWindowLong(Çerçeve, (-16)) Or &H80000 Or &H20000 Or &H10000
SetWindowLong Çerçeve, (-16), Tarz
ShowWindow Çerçeve, 5 '3
DrawMenuBar Çerçeve
DoEvents
End Property
Public Property Set KapatEtkili(Form As Object)

On Error Resume Next
DeleteMenu GetSystemMenu(FindWindow("ThunderDFrame", Form.Caption), 1), &HF060, 0&
DrawMenuBar Çerçeve
End Property
Public Property Set KapatEtkisiz(Form As Object)

On Error Resume Next
DeleteMenu GetSystemMenu(FindWindow("ThunderDFrame", Form.Caption), 0), &HF060, 0&
DrawMenuBar Çerçeve
End Property

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