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

10 Nisan 2007 Salı

Loan Calculator



'Module1

Option Explicit
Dim Sayfa
Sub BorçHesabıDüzenle() 'Loan Calculator Create
    On Error Resume Next
    For Each Sayfa In ThisWorkbook.Sheets
    If Sayfa.Name = "LoanCalculator" Then GoTo Devam
    Next Sayfa
    ThisWorkbook.Worksheets.Add Before:=Sheets(1)
    ActiveSheet.Name = "LoanCalculator"
    Call FormülDüzenle
    Call Biçimlendir
    Call ÖrnekBorçHesabı
    Exit Sub
Devam:
    Sayfa.Select
    Call FormülDüzenle
    Call Biçimlendir
    Call ÖrnekBorçHesabı
End Sub
Private Sub FormülDüzenle() 'Formula Statement

    On Error Resume Next
    ActiveSheet.Unprotect
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("$A$1").FormulaR1C1 = "Ödeme Koşulları"
    Range("$E$1").FormulaR1C1 = "Ara Ödemeler Tablosu"
    Range("$K$1").FormulaR1C1 = "Periyodik Ödemeler Tablosu"
    Range("$G$3").FormulaR1C1 = "=SUM(R[2]C:R[65533]C)"
    Range("$I$3").FormulaR1C1 = "=SUM(R[2]C:R[65533]C)"
    Range("$M$3").FormulaR1C1 = "=SUM(R[2]C:R[65533]C)"
    Range("$N$3").FormulaR1C1 = "=SUM(R[2]C:R[65533]C)"
    Range("$O$3").FormulaR1C1 = "=SUM(R[2]C:R[65533]C)"
    Range("$A$4").FormulaR1C1 = "St"
    Range("$B$4").FormulaR1C1 = "Satış Tarihi"
    Range("$C$4").FormulaR1C1 = ""
    Range("$E$4").FormulaR1C1 = "Ödeme No"
    Range("$F$4").FormulaR1C1 = "Ödeme Tarihi"
    Range("$G$4").FormulaR1C1 = "Vadeli Tutar"
    Range("$H$4").FormulaR1C1 = "Faiz Tutarı"
    Range("$I$4").FormulaR1C1 = "Peşin Tutarı"
    Range("$K$4").FormulaR1C1 = "Ödeme No"
    Range("$L$4").FormulaR1C1 = "Ödeme Tarihi"
    Range("$M$4").FormulaR1C1 = "Ödeme Tutarı"
    Range("$N$4").FormulaR1C1 = "Faiz Tutarı"
    Range("$O$4").FormulaR1C1 = "Anapara Tutarı"
    Range("$P$4").FormulaR1C1 = "Kalan"
    Range("$A$5").FormulaR1C1 = "Pst"
    Range("$B$5").FormulaR1C1 = "Peşin satış Tutarı"
    Range("$C$5").FormulaR1C1 = ""
    Range("$E$5").FormulaR1C1 = "1"
    Range("$H$5").FormulaR1C1 = "=+RC[-1]-RC[1]"
    Range("$I$5").FormulaR1C1 = "=RC[-2]/(1+R12C3)^(RC[-3]-R4C3+1)"
    Range("$K$5").FormulaR1C1 = "1"
    Range("$L$5").FormulaR1C1 = "=DATE(YEAR(R4C3),MONTH(R4C3)+RC[-1]*R13C3,DAY(R4C3))"
    Range("$M$5").FormulaR1C1 = "=+R[11]C[-10]"
    Range("$N$5").FormulaR1C1 = "=R[4]C[-11]*R14C3"
    Range("$O$5").FormulaR1C1 = "=+RC[-2]-RC[-1]"
    Range("$P$5").FormulaR1C1 = "=R[4]C[-13]-RC[-1]"
    Range("$A$6").FormulaR1C1 = "Po"
    Range("$B$6").FormulaR1C1 = "Peşinat Oranı"
    Range("$C$6").FormulaR1C1 = ""
    Range("$E$6").FormulaR1C1 = "=R[-1]C+1"
    Range("$H$6").FormulaR1C1 = "=+RC[-1]-RC[1]"
    Range("$I$6").FormulaR1C1 = "=RC[-2]/(1+R12C3)^(RC[-3]-R4C3+1)"
    Range("$K$6").FormulaR1C1 = "=+R[-1]C+1"
    Range("$L$6").FormulaR1C1 = "=IF(RC[-1]>R15C3,"""",DATE(YEAR(R4C3),MONTH(R4C3)+RC[-1]*R13C3,DAY(R4C3)))"
    Range("$M$6").FormulaR1C1 = "=IF(RC[-2]>R15C3,0,R5C13)"
    Range("$N$6").FormulaR1C1 = "=IF(RC[-3]>R15C3,0,R[-1]C[2]*R14C3)"
    Range("$O$6").FormulaR1C1 = "=+RC[-2]-RC[-1]"
    Range("$P$6").FormulaR1C1 = "=+R[-1]C-RC[-1]"
    Range("$A$7").FormulaR1C1 = "Pt"
    Range("$B$7").FormulaR1C1 = "Peşinat Tutarı"
    Range("$C$7").FormulaR1C1 = "=+R[-2]C*R[-1]C"
    Range("$A$8").FormulaR1C1 = "Aöp"
    Range("$B$8").FormulaR1C1 = "Ara Ödemeleri Peşin Değeri"
    Range("$C$8").FormulaR1C1 = "=+R[-5]C[6]"
    Range("$A$9").FormulaR1C1 = "Vet"
    Range("$B$9").FormulaR1C1 = "Vadeye Esas Tutar"
    Range("$C$9").FormulaR1C1 = "=+R[-4]C-R[-2]C-R[-1]C"
    Range("$A$10").FormulaR1C1 = "Yfo"
    Range("$B$10").FormulaR1C1 = "Yıllık Faiz Oranı"
    Range("$C$10").FormulaR1C1 = ""
    Range("$A$11").FormulaR1C1 = "Afo"
    Range("$B$11").FormulaR1C1 = "Aylık Faiz Oranı"
    Range("$C$11").FormulaR1C1 = "=+R[-1]C/12"
    Range("$A$12").FormulaR1C1 = "Gfo"
    Range("$B$12").FormulaR1C1 = "Günlük Faiz Oranı"
    Range("$C$12").FormulaR1C1 = "=+R[-2]C/365"
    Range("$A$13").FormulaR1C1 = "Öp"
    Range("$B$13").FormulaR1C1 = "Ödeme Periyodu [1, 2, 3, 4..12 Ay]"
    Range("$C$13").FormulaR1C1 = ""
    Range("$A$14").FormulaR1C1 = "Pfo"
    Range("$B$14").FormulaR1C1 = "Periyodik Faiz Oranı"
    Range("$C$14").FormulaR1C1 = "=R[-4]C*R[-1]C/12"
    Range("$A$15").FormulaR1C1 = "Ts"
    Range("$B$15").FormulaR1C1 = "Taksit Sayısı [Adet]"
    Range("$C$15").FormulaR1C1 = ""
    Range("$A$16").FormulaR1C1 = "Tt"
    Range("$B$16").FormulaR1C1 = "Taksit Tutarı"
    Range("$C$16").FormulaR1C1 = "=IF(R[-2]C=0,0,(R[-7]C*R[-2]C)/(1-(1/(1+R[-2]C)^R[-1]C)))"
    Range("$A$17").FormulaR1C1 = "Vt"
    Range("$B$17").FormulaR1C1 = "Vadeli Tutar"
    Range("$C$17").FormulaR1C1 = "=+R[-1]C*R[-2]C"
    Range("$A$18").FormulaR1C1 = "Aöv"
    Range("$B$18").FormulaR1C1 = "Ara Ödemeleri Vadeli Değeri"
    Range("$C$18").FormulaR1C1 = "=+R[-15]C[4]"
    Range("$A$19").FormulaR1C1 = "Vst"
    Range("$B$19").FormulaR1C1 = "Vadeli Satış Tutarı"
    Range("$C$19").FormulaR1C1 = "=+R[-2]C+R[-12]C+R[-1]C"
    Range("E6:I6").Copy
    Range("E7:E52").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("K6:P6").Copy
    Range("K7:K364").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub
Private Sub Biçimlendir() 'Formatted

    On Error Resume Next
    With Range("A1:C1")
        .HorizontalAlignment = xlCenter: .VerticalAlignment = xlBottom: .WrapText = False: .Orientation = 0: .AddIndent = False: .IndentLevel = 0: .ShrinkToFit = False: .ReadingOrder = xlContext: .MergeCells = False: .Merge: .Font.Bold = True: .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic:
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        .Borders(xlInsideVertical).LineStyle = xlNone
    End With
    With Range("A4:C19")
        .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
            .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Font
            .Name = "Arial": .Size = 8: .Strikethrough = False: .Superscript = False: .Subscript = False: .OutlineFont = False: .Shadow = False: .Underline = xlUnderlineStyleNone: .ColorIndex = xlAutomatic
        End With
    End With
    Columns("B:B").EntireColumn.AutoFit: Columns("A:A").EntireColumn.AutoFit: Columns("C:C").ColumnWidth = 12
    With Range("C4")
        .NumberFormat = "m/d/yyyy": .Font.ColorIndex = 5: .Font.Bold = True: .Locked = False: .FormulaHidden = False
    End With
    With Range("C5")
        .NumberFormat = "#,##0.00": .Locked = False: .FormulaHidden = False: .Font.ColorIndex = 5: .Font.Bold = True
    End With
    With Range("C6")
        .NumberFormat = "0.00%": .Locked = False: .FormulaHidden = False: .Font.Bold = True: .Font.ColorIndex = 5
    End With
    Range("C7:C9").NumberFormat = "#,##0.00"
    With Range("C10")
        .NumberFormat = "0.00%": .Locked = False: .FormulaHidden = False: .Font.ColorIndex = 5: .Font.Bold = True
    End With
    Range("C11:C12").NumberFormat = "0.00%"
    With Range("C13")
        .Locked = False: .FormulaHidden = False: .Font.ColorIndex = 5: .Font.Bold = True
    End With
    Range("C14").NumberFormat = "0.00%"
    With Range("C15")
        .Locked = False: .FormulaHidden = False: .Font.Bold = True: .Font.ColorIndex = 5
    End With
    Range("C16:C19").NumberFormat = "#,##0.00"
    With Range("E1:I1")
        .HorizontalAlignment = xlCenter: .VerticalAlignment = xlBottom: .WrapText = False: .Orientation = 0: .AddIndent = False: .IndentLevel = 0: .ShrinkToFit = False: .ReadingOrder = xlContext: .MergeCells = False: .Merge: .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        .Borders(xlInsideVertical).LineStyle = xlNone: .Font.Bold = True
    End With
    With Range("E4:I52")
        With .Font
            .Name = "Arial": .Size = 8: .Strikethrough = False: .Superscript = False: .Subscript = False: .OutlineFont = False: .Shadow = False: .Underline = xlUnderlineStyleNone: .ColorIndex = xlAutomatic
        End With
        .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
            .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
    End With
    With Range("E4:I4")
        .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        .Font.Bold = True: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlBottom: .WrapText = False: .Orientation = 0: .AddIndent = False: .IndentLevel = 0: .ShrinkToFit = False: .ReadingOrder = xlContext: .MergeCells = False
    End With
    Columns("E:E").ColumnWidth = 9
    With Range("E5:E52")
        .HorizontalAlignment = xlCenter: .VerticalAlignment = xlBottom: .WrapText = False: .Orientation = 0: .AddIndent = False: .IndentLevel = 0: .ShrinkToFit = False: .ReadingOrder = xlContext: .MergeCells = False
    End With
    Columns("F:I").ColumnWidth = 12
    With Range("G3")
        With .Font
            .Name = "Arial": .Size = 8: .Strikethrough = False: .Superscript = False: .Subscript = False: .OutlineFont = False: .Shadow = False: .Underline = xlUnderlineStyleNone: .ColorIndex = xlAutomatic
        End With
            .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        .NumberFormat = "#,##0.00"
    End With
    With Range("I3")
        With .Font
            .Name = "Arial": .Size = 8: .Strikethrough = False: .Superscript = False: .Subscript = False: .OutlineFont = False: .Shadow = False: .Underline = xlUnderlineStyleNone: .ColorIndex = xlAutomatic
        End With
        .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        .NumberFormat = "#,##0.00"
        End With
        With Range("F5:F52")
            .NumberFormat = "m/d/yyyy": .Font.ColorIndex = 5: .Locked = False: .FormulaHidden = False: .Font.Bold = True
        End With
        With Range("G5:G52")
            .NumberFormat = "#,##0.00": .Locked = False: .FormulaHidden = False: .Font.Bold = True: .Font.ColorIndex = 5
        End With
        Range("H5:I52").NumberFormat = "#,##0.00": Columns("D:D").ColumnWidth = 1: Columns("J:J").ColumnWidth = 1
        With Range("K1:P1")
            .HorizontalAlignment = xlCenter: .VerticalAlignment = xlBottom: .WrapText = False: .Orientation = 0: .AddIndent = False: .IndentLevel = 0: .ShrinkToFit = False: .ReadingOrder = xlContext: .MergeCells = False: .Merge: .Font.Bold = True: .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
            End With
            .Borders(xlInsideVertical).LineStyle = xlNone
        End With
        With Range("M3:O3")
        .NumberFormat = "#,##0.00"
        With .Font
            .Name = "Arial": .Size = 8: .Strikethrough = False: .Superscript = False: .Subscript = False: .OutlineFont = False: .Shadow = False: .Underline = xlUnderlineStyleNone: .ColorIndex = xlAutomatic
        End With
    End With
    With Range("M3")
        .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
    End With
    With Range("N3")
        .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
    End With
    With Range("O3")
        .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
    End With
    With Range("K4:P364")
        With .Font
            .Name = "Arial": .Size = 8: .Strikethrough = False: .Superscript = False: .Subscript = False: .OutlineFont = False: .Shadow = False: .Underline = xlUnderlineStyleNone: .ColorIndex = xlAutomatic
        End With
            .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
            .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
    End With
    With Range("K4:P4")
        .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous: .Weight = xlMedium: .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
        End With
        .Font.Bold = True
        .HorizontalAlignment = xlCenter: .VerticalAlignment = xlBottom: .WrapText = False: .Orientation = 0: .AddIndent = False: .IndentLevel = 0: .ShrinkToFit = False: .ReadingOrder = xlContext: .MergeCells = False
    End With
    Columns("K:K").ColumnWidth = 9: Columns("L:P").ColumnWidth = 12
    With Range("L5:L364")
        .NumberFormat = "m/d/yyyy": .HorizontalAlignment = xlCenter: .VerticalAlignment = xlBottom: .WrapText = False: .Orientation = 0: .AddIndent = False: .IndentLevel = 0: .ShrinkToFit = False: .ReadingOrder = xlContext: .MergeCells = False
    End With
    With Range("K5:K364")
        .HorizontalAlignment = xlCenter: .VerticalAlignment = xlBottom: .WrapText = False: .Orientation = 0: .AddIndent = False: .IndentLevel = 0: .ShrinkToFit = False: .ReadingOrder = xlContext: .MergeCells = False
    End With
    Range("M5:P364").NumberFormat = "#,##0.00"
    Rows("2:2").RowHeight = 6
    Range("C4").Select
    With Range("A1:C1,E1:I1,K1:P1,E4:I4,K4:P4").Interior
        .Pattern = xlLightUp
        .PatternThemeColor = xlThemeColorDark1
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .PatternTintAndShade = -0.249946592608417
    End With
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Private Sub ÖrnekBorçHesabı() 'Example

    On Error Resume Next
    Range("C4").FormulaR1C1 = "6/4/2009"
    Range("C5").FormulaR1C1 = "6000000"
    Range("C6").FormulaR1C1 = "25%"
    Range("C10").FormulaR1C1 = "10%"
    Range("C13").FormulaR1C1 = "3"
    Range("C15").FormulaR1C1 = "36"
    Range("F5").FormulaR1C1 = "7/12/2009"
    Range("F6").FormulaR1C1 = "9/6/2009"
    Range("F7").FormulaR1C1 = "11/19/2009"
    Range("F8").FormulaR1C1 = "12/24/2009"
    Range("F9").FormulaR1C1 = "3/27/2010"
    Range("G5").FormulaR1C1 = "200000"
    Range("G6").FormulaR1C1 = "210000"
    Range("G7").FormulaR1C1 = "165000"
    Range("G8").FormulaR1C1 = "320000"
    Range("G9").FormulaR1C1 = "290000"
End Sub

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

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