Punya Account Blogger?
Posted by Sofyan SOX on Selasa, 11 Mei 2010 in


Sub bersih()
On Error Resume Next
  tkode.Text = ""
  tnama.Text = ""
  tsatuan.Text = ""
  tstok.Text = ""
  thjual.Text = ""
  thbeli.Text = ""
End Sub

Sub aktif()
On Error Resume Next
  tkode.Enabled = 1
  tnama.Enabled = 1
  tsatuan.Enabled = 1
  tstok.Enabled = 1
  thjual.Enabled = 1
  thbeli.Enabled = 1
End Sub

Sub nonaktif()
On Error Resume Next
  tkode.Enabled = 0
  tnama.Enabled = 0
  tsatuan.Enabled = 0
  tstok.Enabled = 0
  thjual.Enabled = 0
  thbeli.Enabled = 0
End Sub

Sub nomor()
On Error Resume Next
 Dim no As Integer
 Dim tgl As String
 tgl = "BR" & Mid(Str(Date), 1, 2) & Mid(Str(Date), 4, 2)
 If Adodc1.Recordset.RecordCount < 1 Then
    tkode.Text = tgl & "0001"
 Else
    Adodc1.Recordset.MoveLast
     no = Val(Right(Adodc1.Recordset!kdbar, 4)) + 1
     If no < 10 Then
        tkode.Text = tgl & "000" & no
     ElseIf no < 100 Then
        tkode.Text = tgl & "00" & no
     ElseIf no < 1000 Then
        tkode.Text = tgl & "0" & no
     ElseIf no < 10000 Then
        tkode.Text = tgl & no
     End If
 End If
End Sub


Private Sub ccari_Click()
On Error Resume Next
Dim cari As String
cari = UCase(Trim(InputBox("Masukan Kode Barang : ")))
  Adodc1.Recordset.Find " kdbar = '" & cari & "'", , adSearchForward
  If Adodc1.Recordset.EOF Then
     MsgBox "Data Tidak ada"
  Else
     tkode.Text = Adodc1.Recordset!kdbar
     tnama.Text = Adodc1.Recordset!nmbar
     tsatuan.Text = Adodc1.Recordset!satuan
     tstok.Text = Adodc1.Recordset!stok
     thjual.Text = Adodc1.Recordset!hjual
     thbeli.Text = Adodc1.Recordset!hbeli
     aktif
  End If
End Sub


Private Sub cclose_Click()
On Error Resume Next
 If MsgBox("Keluar ?", vbYesNo) = vbYes Then Unload Me
End Sub


Private Sub cdel_Click()
On Error Resume Next
 If tkode.Text = "" Then
    MsgBox "Isi Kode Barang"
 Else
  Adodc1.Recordset.Delete
  MsgBox "data terhapus"
 End If
 bersih
 nonaktif
End Sub


Private Sub cedit_Click()
On Error Resume Next
 If tkode.Text = "" Then
    MsgBox "Isi Kode terlebih dahulu"
 Else
      Adodc1.Recordset!kdbar = tkode.Text
      Adodc1.Recordset!nmbar = tnama.Text
      Adodc1.Recordset!satuan = tsatuan.Text
      Adodc1.Recordset!stok = tstok.Text
      Adodc1.Recordset!hjual = thjual.Text
      Adodc1.Recordset!hbeli = thbeli.Text
    Adodc1.Recordset.Update
    MsgBox "Data Tersimpan"
    bersih
    nonaktif
 End If
End Sub


Private Sub cnew_Click()
On Error Resume Next
 aktif
 bersih
 nomor
End Sub


Private Sub csave_Click()
On Error Resume Next
Dim cari As String
 If tkode.Text = "" Or tnama.Text = "" Then
    MsgBox "Isi Nama Barang terlebih dahulu"
 Else

  cari = UCase(Trim(tkode.Text))
  Adodc1.Recordset.Find " kdbar = '" & cari & "'", , adSearchForward
  
  If Not Adodc1.Recordset.EOF Then
     MsgBox "Kode barang sudah ada"
  Else
    Adodc1.Recordset.AddNew
      Adodc1.Recordset!kdbar = tkode.Text
      Adodc1.Recordset!nmbar = tnama.Text
      Adodc1.Recordset!satuan = tsatuan.Text
      Adodc1.Recordset!stok = Val(tstok.Text)
      Adodc1.Recordset!hjual = Val(thjual.Text)
      Adodc1.Recordset!hbeli = Val(thbeli.Text)
    Adodc1.Recordset.Update
    MsgBox "Data Tersimpan"
    bersih
    nonaktif
  End If
End If
End Sub



Private Sub DataGrid1_DblClick()
On Error Resume Next
Dim cari As String
cari = UCase(Trim(DataGrid1.Text))
  Adodc1.Recordset.Find " kdbar = '" & cari & "'", , adSearchForward
  If Not Adodc1.Recordset.EOF Then
     tkode.Text = Adodc1.Recordset!kdbar
     tnama.Text = Adodc1.Recordset!nmbar
     tsatuan.Text = Adodc1.Recordset!satuan
     tstok.Text = Adodc1.Recordset!stok
     thjual.Text = Adodc1.Recordset!hjual
     thbeli.Text = Adodc1.Recordset!hbeli
     aktif
  End If
End Sub


Private Sub Form_Activate()
On Error Resume Next
 bersih
 nonaktif
 cnew.SetFocus
End Sub


0 Responses to “Form Data Barang dengan Konsep ADODC”:

Posting Komentar