Function HariLibur(ByVal StartDate As Date, ByVal EndDate As Date) As
Integer
'Fungsi untuk menghitung hari libur antara dua tanggal
'Hari libur itu Sabtu, Minggu berarti WeekDay(Tgltsb,vbMOnday)=6 atau 7
'Nama tabel yang dipake adalah tblLibur
'Nama field yang digunakan adalah TglLibur
Dim Counter, HitHari
Dim rstSQL As String
Counter = 0
HitHari = 0
Do
Counter = Counter + 1
dtDate = DateAdd("d", Counter, StartDate)
'check weekday
cWeekDay = Weekday(dtDate, vbMonday)
Select Case cWeekDay
Case Is >= 6
HitHari = HitHari + 1
Case Else
If jExist(dtDate) >= 1 Then
HitHari = HitHari + 1
End If
End Select
Loop Until dtDate = EndDate
HariLibur = HitHari
End Function
Function jExist(ByVal dtDate As Date)
Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
' ganti dengan setting koneksi anda
Set cnn = CurrentProject.Connection
'ganti tblLibur dan TglLibur sesuai tabel dan field anda
rst.Open "Select tblLibur.* FROM tblLibur Where TglLibur=#" & dtDate &
"#", cnn, adOpenKeyset
jExist = rst.RecordCount
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Function
mdh2-an bisa membantu.
Edy WIYONO
On 4/16/08, ari susanto <[EMAIL PROTECTED]> wrote:
>
>
>
> ari susanto <[EMAIL PROTECTED] <ari_cowo_80an%40yahoo.com>> wrote:
> VB Master,
> teman-teman, tolong dong...saya mau menghitung hari libur.
> saya sudah buat table hari libur nasional.....
> isinya tablenya seperti ini :
> nama table : Thrlbr
> field : tglhrlbr > sebagai unix
> field : keterangan
> item nya :
> ex :
> tglhrlbr Ket :
> 12/04/2008 Hr raya....A
> 15/05/2008 Hr raya....B
> 16/05/2008 Hr raya....C
> 17/08/2008 Hr kemerdekaan RI
>
> codingnya seperti ini :
>
> Dim rstglmsk As ADODB.Recordset
> Dim sqltglmsk As String
>
> Dim rsSla As ADODB.Recordset
> Dim sqlsla As String
>
> Dim rslbr As ADODB.Recordset
> Dim sqllbr As String
>
> Dim tgl As String
> Dim jenis As String
> Dim status As String
> Dim IDPerbaikan As String
> Dim lsMsk As ListItem
> Dim ctr As Long
> FrmListOpen.Enabled = True
> FrmMenu.Enabled = False
>
> Dim ssla As String
> Dim totsla As String
> 'Dim slalbr As String
> Dim snn As String
>
> Set rstglmsk = New ADODB.Recordset
> sqltglmsk = "select * from tBrgmsk"
> rstglmsk.Open sqltglmsk, cnn, adOpenKeyset, adLockReadOnly
> rstglmsk.Find "NoID = '" & T1.Text & "'"
> If Not rstglmsk.EOF Then
> hr = Format(rstglmsk!TglMsk, "dddd")
> If hr = "sunday" Then
> ltglsli.Caption = DT3.Value
> ltglmsk.Caption = Format(rstglmsk!TglMsk, "dd/MM/yyyy")
> snn = "Senin"
> Set rsSla = New ADODB.Recordset
> sqlsla = "select SLA from tSlasoft where hari = '" & snn & "'"
> rsSla.Open sqlsla, cnn, adOpenKeyset, adLockReadOnly
> If Not rsSla.EOF Then
> jumtgl.Caption = rstglmsk.Fields("tglmsk").Value +
> rsSla.Fields("SLA").Value
> Set rslbr = cnn.Execute("select count(*) as slalbr from thrlbr where
> Tglhrlbr > '" & ltglmsk.Caption & "' and Tglhrlbr < '" & ltglsli.Caption &
> "'")
> totsla = jumtgl.Caption + slalbr
> If totsla >= ltglsli.Caption Then
> LSLA.Caption = 1
> ElseIf totsla < ltglsli.Caption Then
> LSLA.Caption = 0
> End If
> End If
> End If
> If hr = "Tuesday" Then
> ltglsli.Caption = DT3.Value
> ltglmsk.Caption = Format(rstglmsk!TglMsk, "dd/MM/yyyy")
> snn = "Selasa"
> Set rsSla = New ADODB.Recordset
> sqlsla = "select SLA from tSlasoft where hari = '" & snn & "'"
> rsSla.Open sqlsla, cnn, adOpenKeyset, adLockReadOnly
> If Not rsSla.EOF Then
> jumtgl.Caption = rstglmsk.Fields("tglmsk").Value +
> rsSla.Fields("SLA").Value
> totsla = jumtgl.Caption
> If totsla >= ltglsli.Caption Then
> LSLA.Caption = 1
> ElseIf totsla < ltglsli.Caption Then
> LSLA.Caption = 0
> End If
> End If
> End If
> If hr = "Wednesday" Then
> ltglsli.Caption = DT3.Value
> ltglmsk.Caption = Format(rstglmsk!TglMsk, "dd/MM/yyyy")
> snn = "Rabu"
> Set rsSla = New ADODB.Recordset
> sqlsla = "select SLA from tSlasoft where hari = '" & snn & "'"
> rsSla.Open sqlsla, cnn, adOpenKeyset, adLockReadOnly
> If Not rsSla.EOF Then
> jumtgl.Caption = rstglmsk.Fields("tglmsk").Value +
> rsSla.Fields("SLA").Value
> totsla = jumtgl.Caption
> If totsla >= ltglsli.Caption Then
> LSLA.Caption = 1
> ElseIf totsla < ltglsli.Caption Then
> LSLA.Caption = 0
> End If
> End If
> End If
> If hr = "Thursday" Then
> ltglsli.Caption = DT3.Value
> ltglmsk.Caption = Format(rstglmsk!TglMsk, "dd/MM/yyyy")
> snn = "Kamis"
> Set rsSla = New ADODB.Recordset
> sqlsla = "select SLA from tSlasoft where hari = '" & snn & "'"
> rsSla.Open sqlsla, cnn, adOpenKeyset, adLockReadOnly
> If Not rsSla.EOF Then
> jumtgl.Caption = rstglmsk.Fields("tglmsk").Value +
> rsSla.Fields("SLA").Value
> totsla = jumtgl.Caption
> If totsla >= ltglsli.Caption Then
> LSLA.Caption = 1
> ElseIf totsla < ltglsli.Caption Then
> LSLA.Caption = 0
> End If
> End If
> End If
> If hr = "Friday" Then
> ltglsli.Caption = DT3.Value
> ltglmsk.Caption = Format(rstglmsk!TglMsk, "dd/MM/yyyy")
> snn = "Jumat"
> Set rsSla = New ADODB.Recordset
> sqlsla = "select SLA from tSlasoft where hari = '" & snn & "'"
> rsSla.Open sqlsla, cnn, adOpenKeyset, adLockReadOnly
> If Not rsSla.EOF Then
> jumtgl.Caption = rstglmsk.Fields("tglmsk").Value +
> rsSla.Fields("SLA").Value
> totsla = jumtgl.Caption
> If totsla >= ltglsli.Caption Then
> LSLA.Caption = 1
> ElseIf totsla < ltglsli.Caption Then
> LSLA.Caption = 0
> End If
> End If
> End If
> End If
>
>
> SLA = 2 hari
> saya membuat table nya seperti di bawah ini
>
> hari senin SLA = 2 hari,
> hari selasa SLA = 2 hari,
> hari rabu SLA = 2 hari,
> hari kamis SLA = 4 hari, karena ketemu sabtu & minggu 2 + 2
> hari jum'at SLA = 4 hari, karena ketemu sabtu & minggu 2 + 2
> ini sudah selesai.....dengan coding diatas.
>
> yang saya belum dapatkan nilainya....dibawah ini....????
>
> kalo ketemu hari libur nasional Nasional (lihat table di atas), saya ingin
> menjumlahkan.
> jika hari jum'at ex : tgl 12/05/2008 harusnya SLA jatuh pada tgl 16 (12 +
> 4) tapi karena tgl tersebut ada tanggal merahnya (tanggal 15 & 16 lihat
> table diatas) saya ingin menambah SLA + 2 supaya menjadi tgl 18/05/2008.
> gimana caranya ya, pliz temen2 tolong bantu saya
> ya....pliz...plizz....banget.
>
> salam,
> ari susan
> it operation, bank mandiri
>
>
> ---------------------------------
> Be a better friend, newshound, and know-it-all with Yahoo! Mobile. Try it
> now.
>
> [Non-text portions of this message have been removed]
>
>
>
[Non-text portions of this message have been removed]
