Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Nisan 2007 Cuma

ProgressBar Examples



'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
'Label3, Label4, Label5, ProgressBar1, ProgressBar2, CommandButton1
Option Explicit
Dim i
Dim Oran
Dim PBPencere As Long
Dim Sol, Üst, En, Boy
Dim Adet As Double
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private Declare Function CreateWindowEX Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD ®] ProgressBar Examples"
Call EkranDüzenle
End Sub
Private Sub CommandButton1_Click()

On Error Resume Next
Sol = 80
Üst = 95
En = 294
Boy = 15
Adet = 500000
With ProgressBar1
.Visible = True
ProgressBar2.Visible = True
SendMessage .hwnd, (&H400 + 9), 0&, ByVal &H80C0FF
'Bar Çubuk
SendMessage .hwnd, (&H2000& + 1), 0&, ByVal &HC0& 'Bar Arkası
PBPencere = CreateWindowEX(0, "MSCtls_Progress32", "", &H50000000, Sol, Üst, En, Boy, FindWindow(vbNullString, Me.Caption), 0, 0, 0)
'API Bar
SetParent PBPencere, FindWindow(vbNullString, Me.Caption)
For i = 1 To Adet
Oran = 100 * i / Adet
SendMessage PBPencere, &H402, VBA.Val(Oran) / 1, 0&
ProgressBar2.Value = VBA.Val(Oran)
.Value = VBA.Val(Oran)
Next
.Visible = False
ProgressBar2.Visible = False
DestroyWindow PBPencere
End With
End Sub
Sub EkranDüzenle()

On Error Resume Next
With Me
.Height = 150
.Width = 294
.BackColor = &H8000000F
With Frame1
.Caption = ""
.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 ProgressBar1
.Appearance = cc3D
.Left = 60
.Top = 48
.Height = 12
.Width = 222
.Min = 0
.Max = 100
.Visible = False
End With
With ProgressBar2
.Appearance = cc3D
.Left = 60
.Top = 60
.Height = 12
.Width = 222
.Min = 0
.Max = 100
.Visible = False
End With
With Label3
.Caption = "Renkli PB"
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 48
.Height = 12
.Width = 54
End With
With Label4
.Caption = "Normal PB"
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 60
.Height = 12
.Width = 54
End With
With Label5
.Caption = "API PB"
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 72
.Height = 12
.Width = 54
End With
With CommandButton1
.Caption = "Hesapla"
.Left = 6
.Top = 102
.Height = 18
.Width = 276
End With
End With
ProgressBar1.Value = 0
ProgressBar2.Value = 0
End Sub

'Module1

Option Explicit
Sub FormAç()

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