-->

Minggu, 07 Maret 2010

Mencari Selisih Tanggal (Visual Basic 6)

Persiapan yang dilakukan :
  • Buatlah Project Baru (Standard exe)
  • Tambahkan :
  • 3 Label
  • Label1 (Caption : Mencari Selisih Tanggal)
  • Label2 (Caption : Lahir :)
  • Label3 (Caption : Umur Anda)
  • 1 Buah Frame ------> Caption : Masukan Tanggal Lahir
  • 3 Buah ComboBox ----> Style : 2 - Dropdown List
  • 1 Buah Command Button
yang kurang lebih penampakannya seperti gambar dibawah ini



kemudian ketik Coding dibawah ini pada Form

Option Explicit

Private Sub showTanggal()
Dim i As Byte
For i = 1 To 31
Combo1.AddItem Format(i, "00")
Next i
Combo1.ListIndex = 0
End Sub

Private Sub showBulan()
Dim i As Byte
For i = 1 To 12
Combo2.AddItem Format(i, "00")
Next i
Combo2.ListIndex = 0
End Sub

Private Sub showTahun()
Dim i As Integer
For i = 1950 To Year(Now)
Combo3.AddItem i
Next i
Combo3.ListIndex = 0
End Sub

Private Sub Command1_Click()
Dim sLahir As String
sLahir = Combo1 + "/" + Combo2 + "/" + Combo3
If IsDate(sLahir) = True Then
Label3.Caption = "Umur anda sekarang : " & SelisihTanggal(CDate(sLahir), Date)
Else
MsgBox "Tanggal nya salah coy", 48, "Info"
Combo1.SetFocus
End If
End Sub

Private Sub Form_Load()
showTanggal
showBulan
showTahun
End Sub

Private Function SelisihTanggal(ByVal TanggalAwal As _
Date, ByVal TanggalAkhir As Date) As String

Dim Tahun As Integer, Sisa As Integer
Dim SelisihBulan As Integer
On Error GoTo pesan
SelisihBulan = DateDiff("m", TanggalAwal, TanggalAkhir)
Tahun = SelisihBulan \ 12
Sisa = SelisihBulan Mod 12
SelisihTanggal = Tahun & " Tahun " & Sisa & " Bulan"
Exit Function
pesan:
MsgBox "Tipe Tanggal Salah!", vbCritical, "Error TAnggal"
End Function

Mudah2an ada manfaat nya bagi rekan2.

Tidak ada komentar:

Posting Komentar