Para pakar VB,saya ingin tanya....saya menggunakan VB 6.0 dpt
kesulitan nie....
list programnya spt ini:
----------------------------------------------------------------------
--------------
Sub TombolNormal()
TbTambah.Enabled = True
TbSimpan.Enabled = False
TbUbah.Enabled = True
TbUpdate.Enabled = False
TbHapus.Enabled = False
TbKeluar.Enabled = True
TbUbah.Caption = "Ubah"
TbKeluar.Caption = "Keluar"
End Sub
Sub FormMati()
CmbId.Enabled = False
TxtId.Enabled = False
TxtNama.Enabled = False
CmbKdProdi.Enabled = False
TxtProdi.Enabled = False
TxtAlamat.Enabled = False
TxtTelp.Enabled = False
TxtEmail.Enabled = False
TxtTglEntry.Enabled = False
RbKelamin(0).Enabled = False
RbKelamin(1).Enabled = False
End Sub
Sub FormHidup()
CmbId.Enabled = True
TxtId.Enabled = True
TxtNama.Enabled = True
CmbKdProdi.Enabled = True
TxtProdi.Enabled = True
TxtAlamat.Enabled = True
TxtTelp.Enabled = True
TxtEmail.Enabled = True
TxtTglEntry.Enabled = True
RbKelamin(0).Enabled = True
RbKelamin(1).Enabled = True
End Sub
Sub FormKosong()
CmbId.Text = ""
TxtId.Text = ""
TxtNama.Text = ""
CmbKdProdi.Text = ""
TxtProdi.Text = ""
TxtAlamat.Text = ""
TxtTelp.Text = ""
TxtEmail.Text = ""
TxtTglEntry.Text = ""
TxtTglEntry.Text = "__/__/____"
TxtTglEntry.Enabled = False
RbKelamin(0).Value = True
End Sub
Sub FormNormal()
Call FormKosong ' panggil form kosong
Call FormMati ' panggil form tidak aktif
Call TombolNormal
TbKeluar.Caption = "Keluar"
LblJudul.Caption = "DATA ANGGOTA"
CmbId.Visible = False
TxtId.Visible = True
End Sub
Sub BuatKode()
Dim id As String
If Rs_anggota.BOF Then
TxtId.Text = "A001"
Exit Sub
Else
Rs_anggota.Requery
If Not (Rs_anggota.EOF Or Rs_anggota.BOF) Then
Rs_anggota.MoveLast
End If
id = Rs_anggota!id
id = Right(id, 3)
id = id + 1
End If
If Val(id) < 10 Then
id = "A00" & id
TxtId.Text = id
ElseIf Val(id) < 100 Then
id = "A0" & id
TxtId.Text = id
ElseIf Val(id) < 1000 Then
id = "A" & id
TxtId.Text = id
End If
id = ""
End Sub
Sub CmbKdProdiAktif()
Rs_prodi.Requery
With Rs_prodi
If .EOF And .BOF Then
MsgBox "Tabel Prodi Kosong", vbCritical, "Error"
Else
CmbKdProdi.Clear
Do Until .EOF
CmbKdProdi.AddItem ![kd_prodi] + " | " + ![prodi]
.MoveNext
Loop
.MoveFirst
End If
End With
End Sub
Private Sub Form_Load()
Move (Screen.Width - Width) / 2, _
(Screen.Height - Height) / 3
CmbId.Visible = False
Call FormMati ' mematikan form
Call TombolNormal
Call BukaDatabase
End Sub
Private Sub TbTambah_Click()
Call BuatKode
Call FormHidup
TxtTglEntry.Text = TglSkrg(Date)
TxtNama.SetFocus
TbTambah.Enabled = False
TbSimpan.Enabled = True
TbUbah.Enabled = False
TbUpdate.Enabled = False
TbHapus.Enabled = False
TbKeluar.Enabled = True
Call CmbKdProdiAktif
LblJudul.Caption = "MENAMBAH ANGGOTA BARU"
End Sub
Private Sub CmbKdProdi_Click()
Dim SqlprodiChg As String
Call FormHidup ' Aktifkan form
SqlprodiChg = ""
SqlprodiChg = "SELECT * FROM prodi WHERE " _
& " kd_prodi ='" & Left(CmbKdProdi.Text, 3) & "'"
If Not CmbKdProdi.Text = "" Then
Set Rs_prodiChg = New ADODB.Recordset
Rs_prodiChg.Open SqlprodiChg, KonekDb, _
adOpenDynamic, adLockBatchOptimistic
With Rs_prodiChg
If .EOF And .BOF Then
MsgBox "Kode " + Left(CmbKdProdi.Text, 3) _
+ " tidak ada", _
vbOKOnly + vbCritical, "Perhatian"
Exit Sub
Else
CmbKdProdi.Text = !kd_prodi
TxtProdi.Text = !prodi
TxtProdi.SetFocus
End If
End With
End If
End Sub
Private Sub TbSimpan_Click()
If TxtNama.Text = "" Then
MsgBox "Kolom Nama masih kosong", vbCritical, "Error"
TxtNama.SetFocus
ElseIf CmbKdProdi.Text = "" Then
MsgBox "Kolom Prodi kosong ", vbCritical, "Error"
CmbKdProdi.SetFocus
ElseIf TxtAlamat.Text = "" Then
MsgBox "Kolom Alamat kosong ", vbCritical, "Error"
TxtAlamat.SetFocus
ElseIf TxtTelp.Text = "" Then
MsgBox "Kolom Telepon kosong ", vbCritical, "Error"
TxtTelp.SetFocus
ElseIf TxtEmail.Text = "" Then
MsgBox "Kolom Email kosong ", vbCritical, "Error"
TxtEmail.SetFocus
ElseIf TxtTglEntry.Text = "" Then
MsgBox "Kolom Tgl Entry kosong ", vbCritical, "Error"
TxtTglEntry.SetFocus
Else
' Mengambil nilai pada Radio Button kelamin
Dim SexPilih As String
If RbKelamin(0).Value = True Then
SexPilih = "P"
Else
SexPilih = "W"
End If
SqlSimpan = ""
SqlSimpan = "INSERT INTO anggota" _
& "(id,nama,kd_prodi,alamat,sex,telp,email,tgl_entry)" _
& "VALUES ('" & TxtId.Text & "','" _
& TxtNama.Text & "','" _
& CmbKdProdi.Text & "','" _
& TxtAlamat.Text & "','" _
& SexPilih & "','" _
& TxtTelp.Text & "','" _
& TxtEmail.Text & "','" _
& TxtTglEntry.Text & "')"
KonekDb.Execute SqlSimpan, , adCmdText
Rs_anggota.Requery ' tambah record baru
Call TombolNormal
Call FormNormal
MsgBox "Penyimpanan OK !", vbInformation, "Info"
TbTambah.SetFocus
End If
End Sub
Private Sub TbUbah_Click()
TbTambah.Enabled = False
TbSimpan.Enabled = False
TbUbah.Enabled = False
TbUpdate.Enabled = False
TbHapus.Enabled = False
TbKeluar.Enabled = True
Call FormKosong ' panggil form kosong
Call FormHidup ' panggil form tidak aktif
LblJudul.Caption = "PERBARUI DATA PENERBIT"
CmbId.Clear
CmbId.Visible = True
TxtId.Visible = False
Call CmbKdProdiAktif
Rs_anggota.Requery
With Rs_anggota
If .EOF And .BOF Then
MsgBox "Tabel Anggota Kosong", vbCritical, "Error"
Else
CmbId.Clear
Do Until .EOF
CmbId.AddItem ![id] _
& " | " & ![nama]
.MoveNext
Loop
.MoveFirst
End If
End With
End Sub
Private Sub CmbId_Click()
Dim SqlanggotaChg As String
Call FormHidup ' Aktifkan form
TbTambah.Enabled = False
TbSimpan.Enabled = False
TbUbah.Enabled = False
TbUpdate.Enabled = True
TbHapus.Enabled = True
TbKeluar.Enabled = True
SqlanggotaChg = ""
SqlanggotaChg = "SELECT * FROM anggota WHERE " _
& " id ='" & Left(CmbId.Text, 5) & "'"
Set Rs_anggotaChg = New ADODB.Recordset
Rs_anggotaChg.Open SqlanggotaChg, KonekDb, _
adOpenDynamic, adLockBatchOptimistic
With Rs_anggotaChg
If .EOF And .BOF Then
MsgBox "ID " + Left(CmbId.Text, 5) + "Tidak ada", _
vbCritical, "Perhatian"
Exit Sub
Else
CmbId.Text = !id
TxtNama.Text = !nama
CmbKdProdi.Text = !kd_prodi
TxtAlamat.Text = !alamat
TxtTelp.Text = !telp
TxtEmail.Text = !email
TxtTglEntry.Text = !tgl_entry
Select Case !Sex
Case "P":
RbKelamin(0).Value = True
Case "W":
RbKelamin(1).Value = True
End Select
TxtNama.SetFocus
End If
End With
End Sub
Private Sub TbUpdate_Click()
If TxtNama.Text = "" Then
MsgBox "Kolom Nama masih kosong", vbCritical, "Error"
TxtNama.SetFocus
ElseIf CmbKdProdi.Text = "" Then
MsgBox "Kolom Prodi kosong ", vbCritical, "Error"
CmbKdProdi.SetFocus
ElseIf TxtAlamat.Text = "" Then
MsgBox "Kolom Alamat kosong ", vbCritical, "Error"
TxtAlamat.SetFocus
ElseIf TxtTelp.Text = "" Then
MsgBox "Kolom Telepon kosong ", vbCritical, "Error"
TxtTelp.SetFocus
ElseIf TxtEmail.Text = "" Then
MsgBox "Kolom Email kosong ", vbCritical, "Error"
TxtEmail.SetFocus
ElseIf TxtTglEntry.Text = "" Then
MsgBox "Kolom Tgl Entry kosong ", vbCritical, "Error"
TxtTglEntry.SetFocus
Else
' Mengambil nilai pada Radio Button kelamin
Dim SexPilih As String
If RbKelamin(0).Value = True Then
SexPilih = "P"
Else
SexPilih = "W"
End If
' Perintah mengupdate data
SqlUbah = ""
SqlUbah = "UPDATE anggota " _
& " SET nama='" & TxtNama.Text & "', " _
& " kd_prodi ='" & CmbKdProdi.Text & "', " _
& " alamat ='" & TxtAlamat.Text & "', " _
& " sex ='" & SexPilih & "', " _
& " telp ='" & TxtTelp.Text & "', " _
& " email ='" & TxtEmail.Text & "', " _
& " tgl_entry ='" & TxtTglEntry.Text & "'" _
& " WHERE id='" & Left(CmbId.Text, 5) & "'"
KonekDb.Execute SqlUbah, , adCmdText
Rs_anggota.Requery
Call TombolNormal
Call FormNormal
MsgBox "Perubahan telah disimpan !", vbInformation, "Info"
TbUbah.SetFocus
End If
End Sub
Private Sub TbHapus_Click()
If CmbId.Text = "" Then
MsgBox "ID belum dipilih", vbCritical, "Error"
Else
Konfirmasi = MsgBox("Yakin akan menghapus data ini ?", _
vbYesNo + vbCritical, "Penghapusan")
If Konfirmasi = vbYes Then
SqlHapus = ""
SqlHapus = "DELETE FROM anggota WHERE " _
& " id='" & Left(CmbId.Text, 7) & "'"
KonekDb.Execute SqlHapus, , adCmdText
Rs_anggota.Requery
CmbId.Clear
Call FormNormal
Call TombolNormal
Else ' gagal menghapus
Call FormHidup
End If
End If
End Sub
Private Sub TbKeluar_Click()
If TbKeluar.Caption = "Batal" Then
Call FormMati
Call FormKosong
Call FormNormal
Call TombolNormal
Else
Unload Me
End If
End Sub
Private Sub TxtId_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub TxtNama_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub TxtProdi_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub TxtAlamat_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub RbKelamin_KeyPress(Index As Integer, _
KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub TxtTelp_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
SendKeys "{tab}"
KeyAscii = 0
ElseIf Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") _
Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
End If
End Sub
Private Sub TxtEmail_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub TxtTglEntry_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
----------------------------------------------------------------------
--------------
Saya ingin tanya:
Database yang saya gunakan MySQL,sewaktu saya klik 'simpan',utk tgl
entry kok g spt yg saya ingin kan. saya ingin keluaran misal spt ini
"19-05-2008" atau "2008-05-19" tp stlh saya simpan ke database kok
yang masuk malah "2019-05-20"?
Tlg bimbingannya.........
terima kasih......
RIFKY
