Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Ocak 2007 Çarşamba

Identification Of The Calendar Items


'Module1

Option Explicit
Dim i As Single, No As Single
Dim Tarih As Date, TarihBaş As Date, TarihSon As Date
Dim AyGün As Integer, Hafta As Integer, Ay As Integer, Yıl As Integer, YılGün As Integer, HaftaGün As Integer
Dim GünAdı As String, AyAdı As String
Dim AyınSonuncuGünü As Double, YılınSonuncuGünü As Double
Dim PztA As Double, SalA As Double, ÇarA As Double, PerA As Double, CumA As Double, CtsA As Double, PazA As Double
Dim EklenenSüre As Double, FarkSüre As Double

Sub TariheGünEkle() 'Add day to date
On Error Resume Next
TarihBaş = VBA.Date
EklenenSüre = 1
Call TakviminÖğeleriniTanımlamak(TarihBaş)
Call SayfayaKaydet(TarihBaş, ThisWorkbook.Sheets("Sayfa1"), 2, 0, 0)
TarihSon = VBA.DateAdd("d", EklenenSüre, TarihBaş)
Call TakviminÖğeleriniTanımlamak(TarihSon)
FarkSüre = VBA.DateDiff("d", TarihBaş, TarihSon)
Call SayfayaKaydet(TarihSon, ThisWorkbook.Sheets("Sayfa1"), 3, EklenenSüre, FarkSüre)
End Sub
Sub TariheHaftaEkle() 'Add week to date
On Error Resume Next
TarihBaş = VBA.Date
EklenenSüre = 1
Call TakviminÖğeleriniTanımlamak(TarihBaş)
Call SayfayaKaydet(TarihBaş, ThisWorkbook.Sheets("Sayfa1"), 2, 0, 0)
TarihSon = VBA.DateAdd("ww", EklenenSüre, TarihBaş)
Call TakviminÖğeleriniTanımlamak(TarihSon)
FarkSüre = VBA.DateDiff("ww", TarihBaş, TarihSon)
Call SayfayaKaydet(TarihSon, ThisWorkbook.Sheets("Sayfa1"), 4, EklenenSüre, FarkSüre)
End Sub
Sub TariheAyEkle() 'Add mounth to date
On Error Resume Next
TarihBaş = VBA.Date
EklenenSüre = 1
Call TakviminÖğeleriniTanımlamak(TarihBaş)
Call SayfayaKaydet(TarihBaş, ThisWorkbook.Sheets("Sayfa1"), 2, 0, 0)
TarihSon = VBA.DateAdd("m", EklenenSüre, TarihBaş)
Call TakviminÖğeleriniTanımlamak(TarihSon)
FarkSüre = VBA.DateDiff("m", TarihBaş, TarihSon)
Call SayfayaKaydet(TarihSon, ThisWorkbook.Sheets("Sayfa1"), 5, EklenenSüre, FarkSüre)
End Sub
Sub TariheYılEkle() 'Add year to date
On Error Resume Next
TarihBaş = VBA.Date
EklenenSüre = 1
Call TakviminÖğeleriniTanımlamak(TarihBaş)
Call SayfayaKaydet(TarihBaş, ThisWorkbook.Sheets("Sayfa1"), 2, 0, 0)
TarihSon = VBA.DateAdd("yyyy", EklenenSüre, TarihSon)
Call TakviminÖğeleriniTanımlamak(TarihSon)
FarkSüre = VBA.DateDiff("yyyy", TarihBaş, TarihSon)
Call SayfayaKaydet(TarihSon, ThisWorkbook.Sheets("Sayfa1"), 6, EklenenSüre, FarkSüre)
End Sub
Private Function TakviminÖğeleriniTanımlamak(Tarih) 'Identification of the calendar items
On Error Resume Next
AyGün = VBA.DatePart("d", Tarih, vbMonday, vbFirstJan1)
Hafta = VBA.DatePart("ww", Tarih, vbMonday, vbFirstJan1)
HaftaGün = VBA.DatePart("w", Tarih, vbMonday, vbFirstJan1)
GünAdı = VBA.Format(Tarih, "dddd")
Ay = VBA.DatePart("m", Tarih, vbMonday, vbFirstJan1)
AyAdı = VBA.Format(Tarih, "mmmm")
YılGün = VBA.DatePart("y", Tarih, vbMonday, vbFirstJan1)
Yıl = VBA.DatePart("yyyy", Tarih, vbMonday, vbFirstJan1)
AyınSonuncuGünü = IIf(Ay = 2, IIf((Yıl Mod 4) > 0, 28, 29), IIf(Ay = 4, 30, IIf(Ay = 6, 30, IIf(Ay = 9, 30, IIf(Ay = 11, 30, 31)))))
YılınSonuncuGünü = IIf((Yıl Mod 4) > 0, 365, 366)
PztA = VBA.DatePart("ww", Tarih, vbMonday, vbFirstFullWeek)
SalA = VBA.DatePart("ww", Tarih, vbTuesday, vbFirstFullWeek)
ÇarA = VBA.DatePart("ww", Tarih, vbWednesday, vbFirstFullWeek)
PerA = VBA.DatePart("ww", Tarih, vbThursday, vbFirstFullWeek)
CumA = VBA.DatePart("ww", Tarih, vbFriday, vbFirstFullWeek)
CtsA = VBA.DatePart("ww", Tarih, vbSaturday, vbFirstFullWeek)
PazA = VBA.DatePart("ww", Tarih, vbSunday, vbFirstFullWeek)
End Function
Private Function SayfayaKaydet(Tarih, ByVal Sayfa As Worksheet, ByVal KolonNo As Double, EklenenSüre, FarkSüre) 'Recording
On Error Resume Next
Sayfa.Cells(2, KolonNo) = Tarih
Sayfa.Cells(3, KolonNo) = AyGün
Sayfa.Cells(4, KolonNo) = Hafta
Sayfa.Cells(5, KolonNo) = HaftaGün
Sayfa.Cells(6, KolonNo) = GünAdı
Sayfa.Cells(7, KolonNo) = Ay
Sayfa.Cells(8, KolonNo) = AyAdı
Sayfa.Cells(9, KolonNo) = YılGün
Sayfa.Cells(10, KolonNo) = Yıl
Sayfa.Cells(11, KolonNo) = EklenenSüre
Sayfa.Cells(12, KolonNo) = FarkSüre
Sayfa.Cells(14, KolonNo) = AyınSonuncuGünü
Sayfa.Cells(15, KolonNo) = YılınSonuncuGünü
Sayfa.Cells(17, KolonNo) = PztA
Sayfa.Cells(18, KolonNo) = SalA
Sayfa.Cells(19, KolonNo) = ÇarA
Sayfa.Cells(20, KolonNo) = PerA
Sayfa.Cells(21, KolonNo) = CumA
Sayfa.Cells(22, KolonNo) = CtsA
Sayfa.Cells(23, KolonNo) = PazA
End Function

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