Punya Account Blogger?
Posted by Sofyan SOX on Rabu, 12 Mei 2010 in

Download | di ziddu


Sub mulai()
  'Tampilan Awal
  Me.Rservice.RecordSource = "select * from service"
  Me.Rservice.Refresh
  
  Me.Caption = jdl.Caption
  depan
  bersih
  mati
  tfilter.SetFocus
End Sub
Sub isicombo()
'Mengisi Field Data Kurir
  On Error GoTo pusing
    With Rservice
       .RecordSource = "select * from service"
           
          For i = 0 To .Recordset.Fields.Count - 1
            Me.cbfilter.AddItem .Recordset.Fields(i).Name
          Next

    End With
  Exit Sub
pusing:
  MsgBox Err.Number & Err.Description
End Sub
Sub bersih()
 Me.tkode.Text = ""
 Me.tnama.Text = ""
 Me.cbkategori.Text = ""
 Me.cbsubkat.Text = ""
 Me.tharga.Text = ""
 Me.tkomisi.Text = ""
End Sub
Sub hidup()
 Me.tkode.Enabled = 1
 Me.tnama.Enabled = 1
 Me.cbkategori.Enabled = 1
 Me.cbsubkat.Enabled = 1
 Me.tharga.Enabled = 1
 Me.tkomisi.Enabled = 1
End Sub
Sub mati()
 Me.tkode.Enabled = 0
 Me.tnama.Enabled = 0
 Me.cbkategori.Enabled = 0
 Me.cbsubkat.Enabled = 0
 Me.tharga.Enabled = 0
 Me.tkomisi.Enabled = 0
End Sub

Sub depan()
  Data1.Visible = 1
  Data2.Visible = 0
End Sub
Sub belakang()
  Data1.Visible = 0
  Data2.Visible = 1
End Sub
Sub simpan()
'menyimpan data ke Tabel
  With Me.Rservice.Recordset
    !kode_service = UCase(Me.tkode.Text)
    !nama_service = Me.tnama.Text
    !kategori = Me.cbkategori.Text
    !sub_kategori = Me.cbsubkat.Text
    !harga_jual = Val(Me.tharga.Text)
    !komisi = Val(Me.tkomisi.Text)
  End With
End Sub
Sub tampil()
On Error Resume Next
'menampilkan Isi Tabel Ke Form
  With Me.Rservice.Recordset
    Me.tkode.Text = !kode_service
    Me.tnama.Text = !nama_service
    Me.cbkategori.Text = !kategori
    Me.cbsubkat.Text = !sub_kategori
    Me.tharga.Text = !harga_jual
    Me.tkomisi.Text = !komisi
  End With
End Sub

Private Sub cbatal_Click()
  mulai
End Sub

Private Sub cblevel_Click()
 csimpan.SetFocus
End Sub









Private Sub cbkategori_KeyPress(KeyAscii As Integer)
If KeyAscii = 9 Then Me.cbsubkat.SetFocus
 If KeyAscii = 13 Then
   Me.cbsubkat.SetFocus
 End If
End Sub

Private Sub cbsubkat_Click()
  Me.tharga.SetFocus
End Sub

Private Sub cbsubkat_KeyPress(KeyAscii As Integer)
If KeyAscii = 9 Then Me.tharga.SetFocus
 If KeyAscii = 13 Then
   Me.tharga.SetFocus
 End If
End Sub

Private Sub ccari_Click()
  On Error GoTo pusing
    With Rservice
       .RecordSource = "select * from service where " & cbfilter.Text & " like '%" & tfilter.Text & "%'  "
       .Refresh
       
       'Jika data yang dicari tidak ada
       If .Recordset.EOF Then
          MsgBox "Data Tidak ada", vbOKOnly, "Cari"
       Else
          belakang
          hidup
          tampil
       End If
    End With
  Exit Sub
pusing:
  MsgBox Err.Number & Err.Description
End Sub

Private Sub chapus_Click()
  On Error GoTo pusing
  
   Dim cari As String
   cari = UCase(Trim(tkode.Text))

  'Jika teks ga diisi
  If tkode.Text = "" Or tnama.Text = "" Then
     MsgBox "Lengkapi Data", vbOKOnly, "Salah"
     mulai
     belakang
     hidup
     tkode.SetFocus
  Else

    With Rservice
    
       .RecordSource = "select * from service where kode_service= '" & cari & "'"
       .Refresh
       
       'Jika Kode service sudah ada
       If .Recordset.EOF Then
          MsgBox "Kode service Tidak Ada", vbOKOnly, "Salah"
          tkode.Text = ""
          tkode.SetFocus
       Else
          
          'Proses Penghapusan
          .Recordset.Delete
          Me.tfilter.Text = ""
          MsgBox "Data service Berhasil Dihapus", vbOKOnly, "Sukses"
          mulai
       End If
       
    End With
End If
  Exit Sub
pusing:
  MsgBox Err.Number & Err.Description
End Sub

Private Sub ckeluar_Click()
  Unload Me
End Sub

Private Sub csimpan_Click()
  On Error GoTo pusing
  
   Dim cari As String
   cari = UCase(Trim(tkode.Text))

  'Jika teks ga diisi
  If tkode.Text = "" Or tnama.Text = "" Then
     MsgBox "Lengkapi Data", vbOKOnly, "Salah"
     mulai
     belakang
     hidup
     tkode.SetFocus
  Else

    With Rservice
    
       .RecordSource = "select * from service where kode_service= '" & cari & "'"
       .Refresh
       
       'Jika Kode service sudah ada
       If Not .Recordset.EOF Then
          MsgBox "Kode service Sudah Ada", vbOKOnly, "Salah"
          tkode.Text = ""
          tkode.SetFocus
       Else
          
          'Proses Penyimpanan
          .Recordset.AddNew
            simpan
          .Recordset.Update

          
          MsgBox "Data service Tersimpan", vbOKOnly, "Sukses"
          mulai
       End If
       
    End With
End If
  Exit Sub
pusing:
  MsgBox Err.Number & Err.Description
End Sub

Private Sub ctambah_Click()
  belakang
  hidup
  bersih
  tkode.SetFocus
End Sub

Private Sub cubah_Click()
  On Error GoTo pusing
  
   Dim cari As String
   cari = UCase(Trim(tkode.Text))

  'Jika teks ga diisi
  If tkode.Text = "" Or tnama.Text = "" Then
     MsgBox "Lengkapi Data", vbOKOnly, "Salah"
     mulai
     belakang
     hidup
     tkode.SetFocus
  Else

    With Rservice
    
       .RecordSource = "select * from service where kode_service= '" & cari & "'"
       .Refresh
       
  
          
          'Proses Update data
          
            simpan
          .Recordset.Update

          
          MsgBox "Data service Berhasil Di Update", vbOKOnly, "Sukses"
          mulai
       
       
    End With
End If
  Exit Sub
pusing:
  MsgBox Err.Number & Err.Description
End Sub



Private Sub DataGrid1_DblClick()
  On Error GoTo pusing
    With Rservice
       .RecordSource = "select * from service where kode_service = '" & DataGrid1.Text & "'  "
       .Refresh
       
       'Jika data yang dicari tidak ada
       If .Recordset.EOF Then
          MsgBox "Data Tidak ada", vbOKOnly, "Cari"
       Else
          belakang
          hidup
          tampil
       End If
    End With
  Exit Sub
pusing:
  MsgBox Err.Number & Err.Description
End Sub

Private Sub Form_Activate()
  mulai
End Sub

Private Sub Form_Load()
  isicombo
End Sub

Private Sub tfilter_Change()
  On Error GoTo pusing
    With Rservice
    'Menampilkan Grid sesuai dengan kriteria
       .RecordSource = "select * from service where " & cbfilter.Text & " like '%" & tfilter.Text & "%'  "
       .Refresh
    End With
  Exit Sub
pusing:
  MsgBox Err.Number & Err.Description
End Sub

Private Sub tfilter_KeyPress(KeyAscii As Integer)
  On Error GoTo pusing
If KeyAscii = 13 Then
    With Rservice
       .RecordSource = "select * from service where " & cbfilter.Text & " like '%" & tfilter.Text & "%'  "
       '.Refresh
       
       'Jika data yang dicari tidak ada
       If .Recordset.EOF Then
          MsgBox "Data Tidak ada", vbOKOnly, "Cari"
       Else
          belakang
          hidup
          tampil
       End If
    End With
End If
  Exit Sub
pusing:
  MsgBox Err.Number & Err.Description
End Sub



Private Sub tharga_KeyPress(KeyAscii As Integer)
If KeyAscii = 9 Then Me.tkomisi.SetFocus
  If KeyAscii = 13 Then
    Me.tkomisi.SetFocus
  End If
End Sub

Private Sub Timer1_Timer()
'Membuat Judul For Berjalan
  Me.Caption = Right(Me.Caption, 10) + Left(Me.Caption, 1)
End Sub


Private Sub tkode_KeyPress(KeyAscii As Integer)
   On Error GoTo pusing
If KeyAscii = 9 Then Me.tnama.SetFocus
If KeyAscii = 13 Then
    With Rservice
    
   Dim cari As String
   cari = UCase(Trim(tkode.Text))
   
       .RecordSource = "select * from service where kode_service= '" & cari & "'"
       .Refresh
       
       'Jika Kode service Sudah ada
       If Not .Recordset.EOF Then
          MsgBox "Kode service Sudah Ada", vbOKOnly, "Salah"
          tkode.Text = ""
          tkode.SetFocus
       Else
          tnama.SetFocus
       End If
    End With
End If
  Exit Sub
pusing:
  MsgBox Err.Number & Err.Description
End Sub

Private Sub tkomisi_KeyPress(KeyAscii As Integer)
If KeyAscii = 9 Then Me.csimpan.SetFocus
   If KeyAscii = 13 Then
     Me.csimpan.SetFocus
   End If
End Sub

Private Sub tnama_KeyPress(KeyAscii As Integer)
If KeyAscii = 9 Then Me.cbkategori.SetFocus
 If KeyAscii = 13 Then
   Me.cbkategori.SetFocus
 End If
End Sub

0 Responses to “Data Service - Koneksi dengan Adodc & Perintah SQL”:

Posting Komentar