Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Ağustos 2005 Cumartesi

Week Number Of Day Serial




'UserForm1

'AddTools on UserForm1: Image1, Label1, Label2, Label3, Label4, Label5, ListBox1, CommandButton1, TextBox1, Label6, TextBox2, Label7, Label8
Option Explicit
Dim i As Single
Dim Adet As Double
Dim Tarih As Date
Dim a, b, c, d, e, f, g, h

Private Sub UserForm_Initialize()
On Error Resume Next
With Me
.Caption = "[PBİD®]Week Number Of Day Serial"
.width = 281
.height = 289
.BackColor = &H80000016
End With
With ListBox1
.ColumnCount = 4
.ColumnWidths = "42;42;42;126"
.Font.Size = 8
End With
Application.Visible = True
End Sub
Private Sub UserForm_Activate()
On Error Resume Next
TextBox1.Value = VBA.Format("1/9/2008", "dd.mm.yyyy")
TextBox2.Value = VBA.Format(VBA.DateValue("1/1/2009") + 90, "dd.mm.yyyy")
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
Application.Visible = True
End Sub
Private Sub CommandButton1_Click() '[Week Number]
On Error Resume Next
ListBox1.Clear
If VBA.IsDate(VBA.DateValue(TextBox1.Value)) = True And VBA.IsDate(VBA.DateValue(TextBox2.Value)) = True Then
Adet = VBA.DateValue(TextBox2.Value) - VBA.DateValue(TextBox1.Value) + 1
For i = 1 To Adet
Tarih = (i - 1) + VBA.DateValue(TextBox1.Value)
With ListBox1
.AddItem
.List((i - 1), 3) = VBA.Format(Tarih, "dd.mmmm.yyyy dddd")
a = Tarih
'Dönem Sonu tarih
b = VBA.Weekday(Tarih, 2) 'Dönem Sonunun Hafta İçi Gün No
c = VBA.DateSerial(VBA.Year(Tarih) - 1, 12, 31)
'Dönem Sonu Tarihten Önceki Yılın Son Günü
d = VBA.Weekday(c, 2) 'Dönem Başının Hafta İçi Gün No
e = (a + (7 - b))
'Dönem Sonu Haftasının Son Günü
f = (c + (7 - d))
'Dönem Başı Haftasının Son Günü
g = e - f
'İki Hafta Sonu tarih Arasında Geçen Tam Haftalara Ait Gün Sayısı
h = g / 7 'İki Hafta Sonu Tarih Arasında Geçen Hafta Sayısı
If h = 0 Then h = 52
.List((i - 1), 1) = h
.List((i - 1), 2) = b
a = (i - 1) + VBA.DateValue(TextBox1.Value)
'Dönem Sonu tarih
b = VBA.Weekday(Tarih, 2) 'Dönem Sonunun Hafta İçi Gün No
c = VBA.DateValue(TextBox1.Value)
'Dönem Başı Tarih
d = VBA.Weekday(c, 2) 'Dönem Başının Hafta İçi Gün No
e = (a + (7 - b))
'Dönem Sonu Haftasının Son Günü
f = (c + (7 - d))
'Dönem Başı Haftasının Son Günü
g = e - f 'İki Hafta Sonu tarih Arasında Geçen Tam Haftalara Ait Gün Sayısı
h = g / 7 'İki Hafta Sonu Tarih Arasında Geçen Hafta Sayısı
.List((i - 1), 0) = h + 1
DoEvents
End With
Next i
Label1.Caption = ListBox1.List(0, 1)
Label2.Caption = ListBox1.List((Adet - 1), 1)
a = VBA.DateValue(TextBox2.Value) 'Dönem Sonu tarih
b = VBA.Weekday(Tarih, 2)
'Dönem Sonunun Hafta İçi Gün No
c = VBA.DateValue(TextBox1.Value) 'Dönem Başı Tarih
d = VBA.Weekday(c, 2) 'Dönem Başının Hafta İçi Gün No
e = (a + (7 - b)) 'Dönem Sonu Haftasının Son Günü
f = (c + (7 - d)) 'Dönem Başı Haftasının Son Günü
g = e - f 'İki Hafta Sonu tarih Arasında Geçen Tam Haftalara Ait Gün Sayısı
h = g / 7
'İki Hafta Sonu Tarih Arasında Geçen Hafta Sayısı
Label3.Caption = h + 1
End If
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