Re: help VB

Posted by Aiska Hendra

--- In indoprog-vb@yahoogroups.com, SELVI OYE wrote:
para pakar VB, minta tolong dong dgn scrip berikut :
Database acces.
Table Film :
-Â Â Â Â Â Â Â kode_film
-Â Â Â Â Â Â Â judul
-Â Â Â Â Â Â Â qty
-       status ( “ada” & “keluar”)
Â
kronologisnya :
jika judul film dgn qty 3 dan dipinjam 1 berarti tinggal 2 dgn status
“keluar”.
Nah jika film akan dihapus dari database, maka akan diselecsi dgn status
“ada” jadi jika status ada maka bisa dihapus.
Â
Ok, selanjutnya aku udah bikin scrip di Vb seperti ini :
Â
Private Sub listView1_DblClick()
On Error GoTo ErrPesan
Dim i As Integer
Dim TempIndex As Integer
Dim strSQL As String
Dim tempKode, tempstatus As String
Â
Â
   If listView1.ListItems.Count = 0 Then
        Exit Sub
   End If
Â
 TempIndex = listView1.SelectedItem.Index
 tempKode = listView1.ListItems.Item(TempIndex)
Â
  'Konfirmasi penghapusan record
 Â
 jawab = MsgBox("Apakah Anda yakin Data " & kode_film & _
 vbCrLf & " Akan dihapus ? ", vbInformation + vbYesNo)
 If jawab = vbNo Then Exit Sub
 con.Open "Provider = Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path &
"\rental1.mdb"
 If rsfilm.Fields("status") = "ADA" Then
       strSQL = "DELETE FROM film where kode_film = '" & tempKode & "'"
      Â
       con.Execute strSQL
       MsgBox "DATA FILM TELAH DIHAPUS"
Â
 label6.Caption = "Total Record : " & rsfilm.RecordCount
 i = listView1.SelectedItem.Index
 listView1.ListItems.Remove i
 End If
 Exit Sub
ErrPesan:
  MsgBox "Data belum bisa dihapus " & vbCrLf & " Film Masih diPinjam ",
vbInformation
 End Sub
Â
Tapi yg ada adalah masuk ke errpesan, sehingga data tidak bisa dihapus.
Mohon petunjuknya.



Dear Selvi,

Coba anda ganti kode anda menjadi seperti ini:

Private Sub listView1_DblClick()

On Error GoTo ErrPesan
Dim i As Integer
Dim TempIndex As Integer
Dim strSQL As String
Dim tempKode, tempstatus As String

If listView1.ListItems.Count = 0 Then Exit Sub
If listView1.SelectedItem Is Nothing Then Exit Sub
set con = New ADODB.Connection

TempIndex = listView1.SelectedItem.Index
tempKode = listView1.SelectedItem

' Sory disini object rsfilm masih belom jelas dimana posisi kursornya
jadi anda harus memastikan bahwa rsfilm berada pada posisi yang benar
sehingga anda tidak dapat membuat statement apakah status ada.
Sebaiknya anda coba ambil data status dari
listview1.selecteditem.subitem(?) dimana sub item status tersebut ada.

'asumsi bahwa kolom status berada pada subitem 3
if listview1.SelectedItem.SubItem(3) = "ADA" Then
jawab = MsgBox("Apakah Anda yakin Data " & kode_film & _
vbCrLf & " Akan dihapus ? ", vbInformation + vbYesNo)
If jawab = vbYes Then
con.CursorLocation = adUseServer
con.Open "Provider = Microsoft.Jet.OLEDB.4.0; Data Source=" & _
App.Path & "\rental1.mdb"
strSQL = "DELETE * FROM film where kode_film = '" & tempKode & "'"
con.BeginTrans
con.Execute strSQL
con.CommitTrans
listView1.ListItems.Remove TempIndex
MsgBox "DATA FILM TELAH DIHAPUS"
set con = Nothing
End If
Else
MsgBox "Data belum bisa dihapus " & vbCrLf & " Film Masih diPinjam", vbInformation
End If

Exit Sub
ErrPesan:
If con.State = adStateOpen Then
con.RollBackTrans
set con = nothing
End If

MsgBox "Error !!! " & vbCrLf & Err.Description, vbExclamation

End Sub

Note:

BeginTrans
The BeginTrans method starts a new transaction.
This method can also be used to return a long value that is the level
of nested transactions. A top level transaction has a return value of
1. Each additional level increments by one.

CommitTrans
The CommitTrans method saves all changes made since the last
BeginTrans method call, and ends the current transaction.
Since transactions can be nested, all lower-level transactions must be
resolved before you can resolve higher-level transactions.

RollbackTrans
The RollbackTrans method cancels all changes made since the last
BeginTrans method call, and ends the transaction.
Since transactions can be nested, all lower-level transactions must be
resolved before you can resolve higher-level transactions.


Ok semoga dengan sedikit Script diatas dapat membatu anda
Terima Kasih dan Selamat Mencoba

Salam,


Aiska Hendra

1 comments:

  1. Unknown said...

    Untuk memampilkan data grid pada file yang lain bagaimana? Apakah rumus ini sudab benar?
    Private Sub cmdOK_Click()
    Dim totalItem As Integer
    Dim totalHarga As Currency

    Dim rsPenjualan As New ADODB.Recordset
    rsPenjualan.CursorLocation = adUseClient
    rsPenjualan.Open "PENJUALAN", con, adOpenDynamic, adLockOptimistic

    Dim rsDetail As New ADODB.Recordset
    rsDetailPenjualan.CursorLocation = adUseClient
    rsDetailPenjualan.Open "PENJUALAN_DETAIL", con, adOpenDynamic, adLockOptimistic

    rsDetailPenjualan.MoveFirst
    On Error GoTo Hell

    con.BeginTrans
    rsPenjualan.AddNew
    rsPenjualan("kodePenjualan") = txtKodePenjualan.Text
    rsPenjualan("kodeCustomer") = kodeCustomer
    rsPenjualan("tanggalPenjualan") = tanggalPenjualan
    rsPenjualan.Update

    While Not rsDetailPenjualan.EOF
    rsDetailPenjualan.AddNew
    rsDetailPenjualan("kodePenjualan") = rsDetailPenjualan("kodePenjualan")
    rsDetailPenjualan("kodeBarang") = rsDetailPenjualan("kodeBarang")
    rsDetailPenjualan("jumlahBarang") = rsDetailPenjualan("jumlahBarang")
    rsDetailPenjualan("hargaBarang") = rsDetailPenjualan("hargaBarang")
    rsDetailPenjualan.Update
    totalItem = totalItem + Val(rsDetailPenjualan("jumlahBarang"))
    totalHarga = totalHarga + CCur(rsDetailPenjualan("hargaBarang"))
    rsDetailPenjualan.MoveNext
    Wend
    rsPenjualan("totalItemPenjualan") = totalItem
    rsPenjualan("totalHargaPenjualan") = totalHarga
    rsPenjualan.Update
    con.CommitTrans
    GoTo Heaven

    Hell:
    con.RollbackTrans
    MsgBox ("Data Gagal Dimasukkan.")
    GoTo Heaven

    Heaven:
    con.Close
    Unload Me
    End Sub

Post a Comment