MENAMPILKAN PERIODE MINGGUAN DALAM 1 BULAN DENGAN VISUAL BASIC 6.0

Komponen yang diperlukan :
3 buah combo box; 3 buah DTPicker

Setting propertiesnya sebagai berikut :
1. Combo1, name=cmbBulan,    visible=true
2. Combo2, name=cmbTahun,    visible=true
3. Combo3, name=cmbMinggu, visible=true
4. DTPicker1, visible=true, enable=false
5. DTPicker2, visible=true, enable=false
6. DTPicker3, visible=false, enable=false

Code :

Private Sub Form_Load()
On Error Resume Next
Call loadbulan
Call loadtahun
Call settanggal

cmbBulan.Text = Month(Date)
cmbTahun.Text = Year(Date)

Call cariperiode
End Sub
'______________________________________________________________________
Private Sub cmbbulan_Click()
Call cariperiode
End Sub
'______________________________________________________________________
Private Sub cmbtahun_Click()
Call cariperiode
End Sub

'______________________________________________________________________
Sub settanggal()
On Error Resume Next
    DTPicker1.Month = Val(cmbBulan.Text)
    DTPicker1.Year = Val(cmbTahun.Text)
   
    If Not Val(cmbBulan.Text) = 12 Then
        DTPicker2.Month = Val(cmbBulan.Text) + 1
        DTPicker2.Year = Val(cmbTahun.Text)
    Else
        DTPicker2.Month = 1
        DTPicker2.Year = Val(cmbTahun.Text) + 1
    End If
   
    DTPicker1.Day = 1
    DTPicker2.Day = 1
    DTPicker2.Value = DTPicker2.Value - 1
    DTPicker3.Value = DTPicker1.Value
       
End Sub

Sub loadbulan()
    cmbBulan.Clear
    For i = 1 To 12
        cmbBulan.AddItem


i
    Next i
End Sub

'______________________________________________________________________
Sub loadtahun()
    cmbTahun.Clear
    For i = 1 To 5
        cmbTahun.AddItem Year(Date) + i - 5
    Next i
End Sub

'______________________________________________________________________
Sub cariperiode()
    Call settanggal
    satu = 1
    minggu = 1
    CmbMinggu.Clear
    For i = 1 To (DTPicker2.Value - DTPicker1.Value) + 1
        DTPicker3.Value = DTPicker3.Value + 1
   
        dua = i
        If Weekday(DTPicker3.Value, vbMonday) = 1 Then
            If satu = 1 Then satu = 1
            CmbMinggu.AddItem "minggu ke-" & minggu & " : " & Right("0" & satu, 2) & " s.d " & Right("0" & dua, 2)
            satu = i + 1
            minggu = minggu + 1
        Else
            If i = (DTPicker2.Value - DTPicker1.Value) + 1 Then CmbMinggu.AddItem "minggu ke-" & minggu & " : " & Right("0" & satu, 2) & " s.d " & Right("0" & dua, 2)
       
        End If
Next i
End Sub

Screenshot :

Download