Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

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

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