saya tidak pake text box..... tp terima kasih atas bantuannya...... saya akan coba
----- Original Message ---- From: Axwen Alstair <[EMAIL PROTECTED]> To: [email protected] Sent: Monday, May 26, 2008 8:06:11 PM Subject: Re: [Programmer-VB] Tanya Salam Listing yang diposting kepanjangan tuh mas... para pakarnya keburu jenuh tuh bacanya hehehehehe.. .. kalo yang diposting bagian TbSimpan_Click nya saja saya yaqin para pakar dah ngerti masalahnya.. . saya coba bantu ya ( sya jga masih awam nih ) tampilan Tanggalnya pake TextBox ya ?? kenapa ga pake DateTimePicker ?? Project -> Component -> Microsoft Windows Common Controls-2 6.0 jadi user tinggal milih tanggal, ga usah ngetik u/ mhindari User Error dan perintah TbSimpan diganti sedikit jadi ( Misalnya TxTglEntry diganti jdi DtTglEntry ->DateTimePicker) ............ ... ............ ..... & Format(DtTglEntry. value,"MM/ dd/yyyy") & "')" ......... semoga membantu Awin --- On Sat, 5/24/08, rifky86 <[EMAIL PROTECTED] com> wrote: From: rifky86 <[EMAIL PROTECTED] com> Subject: [Programmer- VB] Tanya To: Programmer-VB@ yahoogroups. com Date: Saturday, May 24, 2008, 2:21 AM 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, adLockBatchOptimist ic 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, adLockBatchOptimist ic 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
