Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Şubat 2012 Pazartesi

FindExecutableA Funtion


'UserForm1


'A. Available References List
'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
'B. Available Tools List
'1) İmage1, Label1, Label2
'2) CommandButton1
'3) Label3, Label4
'4) Label5, Label6
Option Explicit
Private Declare Function FindExecutableA Lib "shell32.dll" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
Private hPath As String
Private hFile As String
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] FindExecutableA Funtion"
Call Ekran_Kur
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
hFile = Application.GetOpenFilename
If hFile = "False" Then
Label5.Caption = ""
Else
Label5.Caption = hFile
hPath = VBA.String(255, 0)
FindExecutableA hFile, "\", hPath
Label6.Caption = VBA.Trim(hPath)
End If
End Sub
Private Sub Ekran_Kur()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 112
.Width = 448
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
.SpecialEffect = fmSpecialEffectFlat
With Image1
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.BorderColor = vbBlue
.Picture = Resim(URL2)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Label1
.Left = 36
.Top = 6
.Height = 12
.Width = 240
.Caption = "Mustafa ULUSARAÇ"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label2
.Left = 36
.Top = 18
.Height = 12
.Width = 240
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With CommandButton1
.Left = 6
.Top = 36
.Width = 54
.Height = 48
.BackStyle = fmBackStyleTransparent
.Caption = "Search"
.Font.Bold = True
.ForeColor = &H808000
.Picture = Resim(URL3)
.PicturePosition = fmPicturePositionAboveCenter
End With
With Label3
.Left = 66
.Top = 36
.Height = 24
.Width = 72
.Caption = " Searched File"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.ForeColor = &H808000
End With
With Label4
.Left = 66
.Top = 60
.Height = 24
.Width = 72
.Caption = " Executable File"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.ForeColor = &H808000
End With
With Label5
.Left = 138
.Top = 36
.Height = 24
.Width = 300
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.BackColor = &HFFFFFF
.Font.Bold = False
.ForeColor = &H808000
End With
With Label6
.Left = 138
.Top = 60
.Height = 24
.Width = 300
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.BackColor = &HC0FFFF
.Font.Bold = False
.ForeColor = &H808000
End With
End With
End Sub


'Module1


Option Explicit
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Public Const URL1 As String = "http://2.bp.blogspot.com/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp"
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg"
Public Const URL3 As String = "http://3.bp.blogspot.com/-T8LAuWdsz_U/TcXIq0lIpPI/AAAAAAAACw4/UnomGxo3OEM/s1600/Dosya_A%25C3%25A7.gif"
Public URL As String
Sub Form_Aç() 'Open UserForm
On Error Resume Next
Load UserForm1
End Sub
Public Function Resim(URL) As Picture 'Picture load frome web address...
On Error Resume Next
CLSIDFromString StrPtr(ClsID), IPic(0)
OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim
End Function
'Sub References_List()
'On Error Resume Next
'Dim Eleman, No
'No = 1
'For Each Eleman In ThisWorkbook.VBProject.References
'Sheets(1).Cells(No, 1) = No & ") Name: "
'Sheets(1).Cells(No, 2) = Eleman.Name
'Sheets(1).Cells(No, 3) = ", Description: "
'Sheets(1).Cells(No, 4) = Eleman.Description
'Sheets(1).Cells(No, 5) = ", FullPath: "
'Sheets(1).Cells(No, 6) = Eleman.FullPath
'No = No + 1
'Next Eleman
'End Sub

10 Şubat 2012 Cuma

Make CountDown Timer


'UserForm1

'A. Available References List
'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
'B. Available Tools List
'1) Image1, Label1, Label2
'2) CommandButton1
'3) Label3, Label4, Label5, Label6, Label7, Label8
'C. User-Defined Date/Time Formats (Format Function)
'(:); Time separator. In some locales, other characters may be used to represent the time separator. The time separator separates hours, minutes, and seconds when time values are formatted. The actual character used as the time separator in formatted output is determined by your system settings.
'(/); Date separator. In some locales, other characters may be used to represent the date separator. The date separator separates the day, month, and year when date values are formatted. The actual character used as the date separator in formatted output is determined by your system settings.
'c; Display the date as ddddd and display the time as ttttt, in that order. Display only date information if there is no fractional part to the date serial number; display only time information if there is no integer portion.
'd; Display the day as a number without a leading zero (1 – 31).
'dd; Display the day as a number with a leading zero (01 – 31).
'ddd; Display the day as an abbreviation (Sun – Sat).
'dddd; Display the day as a full name (Sunday – Saturday).
'ddddd; Display the date as a complete date (including day, month, and year),  formatted according to your system's short date format setting. The default short date format is m/d/yy.
'dddddd; Display a date serial number as a complete date (including day, month, and year) formatted according to the long date setting recognized by your system. The default long date format is mmmm dd, yyyy.

'aaaa; The same as dddd, only it's the localized version of the string.
'w; Display the day of the week as a number (1 for Sunday through 7 for Saturday).
'ww; Display the week of the year as a number (1 – 54).
'm; Display the month as a number without a leading zero (1 – 12). If m immediately follows h or hh, the minute rather than the month is displayed.
'mm; Display the month as a number with a leading zero (01 – 12). If m immediately follows h or hh, the minute rather than the month is displayed.
'mmm; Display the month as an abbreviation (Jan – Dec).
'mmmm; Display the month as a full month name (January – December).
'oooo; The same as mmmm, only it's the localized version of the string.
'q; Display the quarter of the year as a number (1 – 4).
'y; Display the day of the year as a number (1 – 366).
'yy; Display the year as a 2-digit number (00 – 99).
'yyyy; Display the year as a 4-digit number (100 – 9999).
'h; Display the hour as a number without leading zeros (0 – 23).
'Hh; Display the hour as a number with leading zeros (00 – 23).
'N; Display the minute as a number without leading zeros (0 – 59).
'Nn; Display the minute as a number with leading zeros (00 – 59).
'S; Display the second as a number without leading zeros (0 – 59).
'Ss; Display the second as a number with leading zeros (00 – 59).
't t t t t; Display a time as a complete time (including hour, minute, and second),  formatted using time separator defined by the time format recognized by your system. A leading zero is displayed if the leading zero option is selected and the time is before 10:00 A.M. or P.M. The default time format is h:mm:ss.
'AM/PM; Use the 12-hour clock and display an uppercase AM with any hour before noon;        display an uppercase PM with any hour between noon and 11:59 P.M.
'am/pm; Use the 12-hour clock and display a lowercase AM with any hour before noon;          display a lowercase PM with any hour between noon and 11:59 P.M.
'A/P; Use the 12-hour clock and display an uppercase A with any hour before noon;           display an uppercase P with any hour between noon and 11:59 P.M.
'a/p; Use the 12-hour clock and display a lowercase A with any hour before noon; display a lowercase P with any hour between noon and 11:59 P.M.
'AMPM; Use the 12-hour clock and display the AM string literal as defined by your system with any hour before noon; display the PM string literal as defined by your system with any hour between noon and 11:59 P.M. AMPM can be either uppercase or lowercase, but the case of the string displayed matches the string as defined by your system settings. The default format is AM/PM.
Private sTime As Double
Private tStop As Boolean
Private Const hDay As Double = 86400 '24 * 60 * 60
Private Const hSec As Double = 60 '1 * 60
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Make CountDown Timer"
Call Ekran_Kur
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
sTime = VBA.Timer + hSec
Label6.Caption = VBA.Format(VBA.Now(), "Hh:Nn:Ss")
Do While sTime > VBA.Timer
DoEvents
If tStop Then
Exit Sub
Else
Label7.Caption = VBA.Format((VBA.Abs(VBA.Int(sTime - VBA.Timer)) / hDay), "Hh:Nn:Ss")
Label8.Caption = VBA.Format((VBA.Timer / hDay), "Hh:Nn:Ss")
End If
Loop
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
tStop = True
End Sub
Private Sub Ekran_Kur()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 108
.Width = 378
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
.SpecialEffect = fmSpecialEffectFlat
With Image1
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.BorderColor = vbBlue
.Picture = Resim(URL2)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Label1
.Left = 36
.Top = 6
.Height = 12
.Width = 240
.Caption = "Mustafa ULUSARAÇ"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label2
.Left = 36
.Top = 18
.Height = 12
.Width = 240
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With CommandButton1
.Left = 6
.Top = 36
.Height = 42
.Width = 42
.Caption = "Start"
.Font.Bold = True
.ForeColor = &H404000
.BackStyle = fmBackStyleTransparent
End With
With Label3
.Left = 60
.Top = 36
.Height = 12
.Width = 102
.Caption = "Start Time"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = False
.ForeColor = &H404000
.TextAlign = fmTextAlignCenter
End With
With Label4
.Left = 162
.Top = 36
.Height = 12
.Width = 102
.Caption = "CountDown Time"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = False
.ForeColor = &H404000
.TextAlign = fmTextAlignCenter
End With
With Label5
.Left = 264
.Top = 36
.Height = 12
.Width = 102
.Caption = "Finish Time"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = False
.ForeColor = &H404000
.TextAlign = fmTextAlignCenter
End With
With Label6
.Left = 60
.Top = 48
.Height = 30
.Width = 102
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = False
.Font.Name = "Arial"
.Font.Size = 20
.ForeColor = &HFF0000
.TextAlign = fmTextAlignCenter
End With
With Label7
.Left = 162
.Top = 48
.Height = 30
.Width = 102
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = False
.Font.Name = "Arial"
.Font.Size = 20
.ForeColor = &HFF0000
.TextAlign = fmTextAlignCenter
End With
With Label8
.Left = 264
.Top = 48
.Height = 30
.Width = 102
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = False
.Font.Name = "Arial"
.Font.Size = 20
.ForeColor = &HFF0000
.TextAlign = fmTextAlignCenter
End With
End With
End Sub

'Module1

Option Explicit
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Public Const URL1 As String = "http://2.bp.blogspot.com/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp"
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg"
Public URL As String
Sub Form_Aç() 'Open UserForm
On Error Resume Next
UserForm1.Show 0
End Sub
Public Function Resim(URL) As Picture 'Picture load frome web address...
On Error Resume Next
CLSIDFromString StrPtr(ClsID), IPic(0)
OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim
End Function
'Sub References_List()
'On Error Resume Next
'Dim Eleman, No
'No = 1
'For Each Eleman In ThisWorkbook.VBProject.References
'Sheets(1).Cells(No, 1) = No & ") Name: "
'Sheets(1).Cells(No, 2) = Eleman.Name
'Sheets(1).Cells(No, 3) = ", Description: "
'Sheets(1).Cells(No, 4) = Eleman.Description
'Sheets(1).Cells(No, 5) = ", FullPath: "
'Sheets(1).Cells(No, 6) = Eleman.FullPath
'No = No + 1
'Next Eleman
'End Sub

1 Şubat 2012 Çarşamba

Use The Excel VBA Numeric Variables Limits For The PI Calculation


'UserForm1

'A. Available References List
'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
'6) Name: MSComctlLib, Description: Microsoft Windows Common Controls 6.0 (SP6), FullPath: C:\Windows\SysWOW64\MSCOMCTL.OCX
'B. Available Tools List
'1) İmage1, Label1, Label2
'2) Label3, Label4, Label5, Label6, Label7, Label8, Label9, Label10
'3) Label11, Label12, CheckBox1, CommandButton1
'C Excel VBA Numeric Variables Limits
'1) Byte data type: A data type used to hold positive integer numbers ranging from 0 to 255. Byte variables are stored as single, unsigned 8-bit (1-byte) numbers.
'2) Boolean data type: A data type with only two possible values, True (-1) or False (0). Boolean variables are stored as 16-bit (2-byte) numbers.
'3) Integer data type: A data type that holds integer variables stored as 2-byte whole numbers in the range -32,768 to 32,767. The Integer data type is also used to represent enumerated values. The percent sign (%) type-declaration character represents an Integer in Visual Basic.
'4) Long data type: A 4-byte integer ranging in value from -2,147,483,648 to 2,147,483,647. The ampersand (&) type-declaration character represents a Long in Visual Basic.
'5) Currency data type: A data type with a range of -922,337,203,685,477.5808 to 922,337,203,685,477.5807. Use this data type for calculations involving money and for fixed-point calculations where accuracy is particularly important. The at sign (@) type-declaration character represents Currency in Visual Basic.
'6) Single data type: A data type that stores single-precision floating-point variables as 32-bit (2-byte) floating-point numbers, ranging in value from -3.402823E38 to -1.401298E-45 for negative values, and 1.401298E-45 to 3.402823E38 for positive values. The exclamation point (!) type-declaration character represents a Single in Visual Basic.
'7) Double data type: A data type that holds double-precision floating-point numbers as 64-bit numbers in the range -1.79769313486232E308 to -4.94065645841247E-324 for negative values; 4.94065645841247E-324 to 1.79769313486232E308 for positive values. The number sign (#) type-declaration character represents the Double in Visual Basic.
'8) Date data type: A data type used to store dates and times as a real number. Date variables are stored as 64-bit (8-byte) numbers. The value to the left of the decimal represents a date, and the value to the right of the decimal represents a time.
'9) String data type: A data type consisting of a sequence of contiguous characters that represent the characters themselves rather than their numeric values. A String can include letters, numbers, spaces, and punctuation. The String data type can store fixed-length strings ranging in length from 0 to approximately 63K characters and dynamic strings ranging in length from 0 to approximately 2 billion characters. The dollar sign ($) type-declaration character represents a String in Visual Basic.
'D PI Calculate Algorithms
'1) Gregory(1638 -1676) algorithm; PI/4 = 1-1/3 +1/5-1/7+1/9-1/11+...........
'2) Madhava Sangamagrama (14.cy) algorithm; PI/4=1-1/3+1/5-1/7+...(+,-) 1/(2n-1)(+,-)...
'E VB Solutions For PI Calculate
'1) EULER Method
'CLS
'INPUT "n="; n
't = 0
'For i = 1 To n
't = t + (1 / i ^ 2)
'PI = Sqr(6 * t)
'Print "~ PI value="; PI
'Next i
'2) LEIBNITZ Method
'CLS
'INPUT "n="; n
't = 0
'c = 1
'For i = 1 To n
't = t + c / ((2 * i) - 1)
'c = (-1) * C
'PI = 4 * t
'Print "~ PI value="; PI
'Next i
'3) LORD BROUNCKER 'İN 1. Method
'CLS
'INPUT "n="; n
't = 0
'c = 1
'For i = 1 To n
't = t + c / ((2 * i) - 1)
'c = (-1) * c
'PI = 4 * t
'Print "~ PI value="; PI
'Next i
'4) LORD BROUNCKER 'İN 2. Method
'CLS
'INPUT "n="; n
't = 0
'For i = 1 To n
't = t + (1 / ((2 * i) ^ 2))
'PI = Sqr(24 * t)
'Print "~ PI value="; PI
'Next i
'5) VIETA Method
'CLS
'INPUT "n="; n
'Count = 1
't = 1
'a = Sqr(2)
'Repeat:
't = t * (a / 2)
'Count = Count + 1
'PI = 2 / t
'Print "Count="; Count
'Print "~ PI value="; PI
'If Count > n Then
'End
'End If
'a = Sqr(a + 2)
'GoTo Repeat
'6) WALLIS 1. Method
'CLS
'INPUT "n="; n
't = 1
'For i = 1 To n
't = t * (2 * i) ^ 2 / (((2 * i) + 1) * ((2 * i) - 1))
'PI = 2 * t
'Print "~ PI value="; PI
'Next i
'7) WALLIS 2. Method
'CLS
'INPUT "n="; n
't = 1
'For i = 1 To n
't = t * (1 - (1 / ((2 * i) ^ 2)))
'PI = 2 / t
'Print "~ PI value="; PI
'Next i
Option Explicit
Private Durum As Boolean
Private i As Currency
Private Const n As Currency = 461168601842738# '922337203685477# \ 2
Private ePI As Double
Private hPI As Double
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Use The Excel VBA Numeric Variables Limits For The PI Calculate"
Call Ekran_Kur
End Sub
Private Sub CheckBox1_Change()
If CheckBox1.Value = True Then
CheckBox1.Caption = "Calculate Hidden"
Else
CheckBox1.Caption = "Calculate Show"
End If
End Sub
Private Sub CommandButton1_Click()
On Error GoTo Hata
CommandButton1.Enabled = False
Label4.Caption = VBA.Format(n, "#,##0")
Label6.Caption = ""
ePI = Application.WorksheetFunction.PI()
Label10.Caption = VBA.Format(ePI, "#,##0.000000000000000")
Call hPI_Hesapla
Exit Sub
Hata:
Label8.Caption = 0
MsgBox "Lütfen MSO Excel® currensy limitinizi kontrol ediniz.", vbInformation, "[PBİD®] Lütfen dikkat!"
End Sub
Private Sub hPI_Hesapla()
On Error GoTo Hata
Label11.Caption = VBA.Time
hPI = 0
Durum = True
For i = 1 To n
If Durum = True Then
hPI = hPI + (4 * 1 / ((i * 2) - 1))
Durum = False
Else
hPI = hPI - (4 * 1 / ((i * 2) - 1))
Durum = True
End If
If CheckBox1.Value = True Then
Label6.Caption = VBA.Format(i, "#,##0")
Label8.Caption = VBA.Format(hPI, "#,##0.000000000000000")
End If
DoEvents
If ePI = hPI Then Exit For
Next i
DoEvents
Label12.Caption = VBA.Time
Label6.Caption = VBA.Format(i, "#,##0")
Label8.Caption = VBA.Format(hPI, "#,##0.000000000000000")
CommandButton1.Enabled = True
DoEvents
Exit Sub
Hata:
hPI = 0
Label8.Caption = ""
End Sub
Private Sub Ekran_Kur()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 166
.Width = 306
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
.SpecialEffect = fmSpecialEffectFlat
With Image1
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.BorderColor = vbBlue
.Picture = Resim(URL2)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Label1
.Left = 36
.Top = 6
.Height = 12
.Width = 240
.Caption = "Mustafa ULUSARAÇ"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label2
.Left = 36
.Top = 18
.Height = 12
.Width = 240
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label3
.Left = 6
.Top = 36
.Height = 18
.Width = 114
.Caption = " Maximum Dimention"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Tahoma"
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label4
.Left = 120
.Top = 36
.Height = 18
.Width = 174
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Tahoma"
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label5
.Left = 6
.Top = 54
.Height = 18
.Width = 114
.Caption = " Used Dimention"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Tahoma"
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label6
.Left = 120
.Top = 54
.Height = 18
.Width = 174
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Tahoma"
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label7
.Left = 6
.Top = 72
.Height = 18
.Width = 114
.Caption = " Calculated PI"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Tahoma"
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label8
.Left = 120
.Top = 72
.Height = 18
.Width = 174
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Tahoma"
.ForeColor = vbBlue
.TextAlign = fmTextAlignRight
End With
With Label9
.Left = 6
.Top = 90
.Height = 18
.Width = 114
.Caption = " MS Excel® PI"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Tahoma"
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label10
.Left = 120
.Top = 90
.Height = 18
.Width = 174
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Tahoma"
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label11
.Left = 6
.Top = 114
.Height = 12
.Width = 54
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Tahoma"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label12
.Left = 6
.Top = 126
.Height = 12
.Width = 54
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Tahoma"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With CheckBox1
.Left = 60
.Top = 114
.Height = 24
.Width = 60
.Caption = "Calculate Show"
.Value = False
.AutoSize = False
.Alignment = fmAlignmentRight
.BackStyle = fmBackStyleTransparent
.Locked = False
.SpecialEffect = fmButtonEffectSunken
End With
With CommandButton1
.Left = 120
.Top = 114
.Height = 24
.Width = 174
.Caption = "PI Calculate"
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Tahoma"
.ForeColor = &H808000
End With
End With
End Sub

'Module1

Option Explicit
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Public Const URL1 As String = "http://2.bp.blogspot.com/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp"
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg"
Public URL As String
Sub Form_Aç() 'Open UserForm
On Error Resume Next
UserForm1.Show 0
End Sub
Public Function Resim(URL) As Picture 'Picture load frome web address...
On Error Resume Next
CLSIDFromString StrPtr(ClsID), IPic(0)
OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim
End Function
'Sub References_List()
'On Error Resume Next
'Dim Eleman, No
'No = 1
'For Each Eleman In ThisWorkbook.VBProject.References
'Sheets(1).Cells(No, 1) = No & ") Name: "
'Sheets(1).Cells(No, 2) = Eleman.Name
'Sheets(1).Cells(No, 3) = ", Description: "
'Sheets(1).Cells(No, 4) = Eleman.Description
'Sheets(1).Cells(No, 5) = ", FullPath: "
'Sheets(1).Cells(No, 6) = Eleman.FullPath
'No = No + 1
'Next Eleman
'End Sub

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