Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

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

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