-
Oct 19th, 2012, 10:34 PM
#1
Thread Starter
Junior Member
Run-time error 3704 operation is not allowed the object is closed
this is my code please help me..
for showing data from search table
Dim objConnection As ADODB.Connection
Dim objCommand As ADODB.Command
Dim objRecordset As ADODB.Recordset
Dim merna As New ADODB.Recordset
Private Sub Cmd_ADD_Click()
SearchProduct_frm.Show vbModal
Dim merna As New ADODB.Recordset
mSQL = " Select * from Product_View "
If merna.State = adStateOpen Then
merna.Close
End If
Set objConnection = New ADODB.Connection
With objConnection
.ConnectionString = Penjualan_Menu.mRoot_StrConn
.Open
If Not .State = adStateOpen Then
MsgBox "tidak dapat membuat hubungan ke database"
Unload Me
End If
End With
load_objrecordset
If merna.EOF = False Then
With SearchProduct_frm
Set .product_grid.DataSource = merna
.product_grid.TextMatrix(0, 0) = "Product ID"
.product_grid.TextMatrix(0, 1) = "Nama Product"
.product_grid.TextMatrix(0, 2) = "Group Product"
.product_grid.TextMatrix(0, 3) = "QTY"
.product_grid.TextMatrix(0, 4) = "Harga"
.product_grid.TextMatrix(0, 5) = "Jumlah"
.product_grid.ColWidth(0) = 1305
.product_grid.ColWidth(1) = 2000
.product_grid.ColWidth(2) = 2000
.product_grid.ColWidth(3) = 800
.product_grid.ColWidth(4) = 2300
.product_grid.ColWidth(5) = 1005
' Cmb_SEARCH.AddItem "Id Product"
'
' .Cmb_SEARCH.ListIndex = 0
' .Show vbModal
End With
Unload SearchProduct_frm
Else
MsgBox "Belum ada Pembelian ataupun Pemesanan!"
End If
If merna.State = adStateOpen Then
merna.Close
End If
Set merna = Nothing
'DataProduct_frm.Show vbModal
End Sub
Private Sub Cmd_EXIT_Click()
If MsgBox("Ingin mengakhiri proses penjualan product ?", vbApplicationModal + vbDefaultButton2 + vbYesNo, "MENU JUAL PRODUCT") = vbYes Then
Unload Me
End If
End Sub
'''Private Sub blank_data() '
''
''txt_alamat.Enabled = False
''txt_Jmlh.Enabled = False
'''txt_kepada.Enabled = False
''txt_NoPenj.Enabled = False
''En d Sub
'
'Private Sub disable_entry()
''txt_CBID.Enabled = False
''txt_NamaPmb.Enabled = False
'End Sub
'Private Sub enabled_entry()
'''txt_CBID.Enabled = True
'''txt_NamaPmb.Enabled = True
'End Sub
'Private Sub disable_command()
''Cmd_ADD.Enabled = False
'End Sub
'Private Sub enabled_command()
'Cmd_NEW.Enabled = True
'Cmd_EXIT.Enabled = True
'Cmd_PAY.Enabled = False
'Cmd_PRINT.Enabled = False
'End Sub
Private Sub Cmd_NEW_Click()
txt_alamat.Enabled = True
txt_Jmlh.Enabled = True
txt_kepada.Enabled = True
txt_NoPenj.Enabled = True
Cmd_ADD.Enabled = True
Cmd_PAY.Enabled = True
Cmd_PRINT.Enabled = True
End Sub
Private Sub Cmd_search_Click()
'Dim merna As New ADODB.Recordset
'
'mSQL = " Select * from Product_View "
'
'If merna.State = adStateOpen Then
' merna.Close
' End If
'
'Set objConnection = New ADODB.Connection
'With objConnection
' .ConnectionString = Penjualan_Menu.mRoot_StrConn
' .Open
' If Not .State = adStateOpen Then
' MsgBox "tidak dapat membuat hubungan ke database"
' Unload Me
' End If
' End With
'
'If merna.EOF = False Then
'With SearchProduct_frm
' Set .product_grid.DataSource = merna
'.product_grid.TextMatrix(0, 0) = "Product ID"
'.product_grid.TextMatrix(0, 1) = "Nama Product"
'.product_grid.TextMatrix(0, 2) = "Group Product"
'.product_grid.TextMatrix(0, 3) = "QTY"
'.product_grid.TextMatrix(0, 4) = "Harga"
'.product_grid.TextMatrix(0, 5) = "Jumlah"
'
'.product_grid.ColWidth(0) = 1305
'.product_grid.ColWidth(1) = 2000
'.product_grid.ColWidth(2) = 2000
'.product_grid.ColWidth(3) = 800
'.product_grid.ColWidth(4) = 2300
'.product_grid.ColWidth(5) = 1005
'
' Cmb_SEARCH.AddItem "Id Product"
'
' .Cmb_SEARCH.ListIndex = 0
' .Show vbModal
'
'End With
'Unload SearchProduct_frm
' Else
' MsgBox "Belum ada Pembelian ataupun Pemesanan!"
' End If
'
' If merna.State = adStateOpen Then
' merna.Close
' End If
' Set merna = Nothing
End Sub
Private Sub Form_Load()
Set objConnection = New ADODB.Connection
With objConnection
.ConnectionString = Penjualan_Menu.mRoot_StrConn
.Open
If Not .State = adStateOpen Then
MsgBox "tidak dapat membuat hubungan ke database"
Unload Me
End If
End With
load_objrecordset
mSQL = " create table #T_Product (" & _
" Kar_ProductID char(12) primary key, " & _
" Kar_NamaProduct varchar(50) null, " & _
" Kar_GroupProduct bit null default 0," & _
" Kar_Qty int null default 0, " & _
" Kar_Harga money not null default 0," & _
" Kar_Jumlah money null default 0," & _
")"
Set objCommand = New ADODB.Command
objCommand.ActiveConnection = objConnection
objCommand.CommandText = mSQL
objCommand.CommandType = adCmdText
' On Error Resume Next
objCommand.Execute
txt_alamat.Enabled = False
txt_Jmlh.Enabled = False
txt_kepada.Enabled = False
txt_NoPenj.Enabled = False
Cmd_ADD.Enabled = False
Cmd_PAY.Enabled = False
Cmd_PRINT.Enabled = False
End Sub
'Private Sub Form_Activate()
'txt_alamat.Enabled = False
'txt_Jmlh.Enabled = False
'txt_kepada.Enabled = False
'txt_NoPenj.Enabled = False
'Cmd_ADD.Enabled = False
'Cmd_PAY.Enabled = False
'Cmd_PRINT.Enabled = False
'End Sub
Private Sub Jual_Grid_AfterEdit(ByVal Row As Long, ByVal Col As Long)
isNextStep = True
If Col = 5 Then
If Jual_Grid.TextMatrix(Row, Col) <= Jual_Grid.TextMatrix(Row, Col - 2) Then
Else
isNextStep = False
End If
End If
End Sub
Private Sub Jual_Grid_CellChanged(ByVal Row As Long, ByVal Col As Long)
If Col = 3 Or Col = 4 Then
If Row > 0 And Jual_Grid.TextMatrix(Row, 3) <> "" And Jual_Grid.TextMatrix(Row, 4) <> "" Then
Jual_Grid.TextMatrix(Row, 5) = Format(CStr(CDbl(Jual_Grid.TextMatrix(Row, 3)) * CDbl(Jual_Grid.TextMatrix(Row, 4))), "#,##0")
Jual_Grid.Text = Format(hitungSubTotal(Beli_Vsx, 5, 0), "#,##0")
End If
End If
End Sub
Private Sub Jual_Grid_AfterDataRefresh()
With Jual_Grid
.TextMatrix(0, 0) = "Product ID"
.TextMatrix(0, 1) = "Nama Product"
.TextMatrix(0, 2) = "Group Product"
.TextMatrix(0, 3) = "QTY"
.TextMatrix(0, 4) = "Harga"
.TextMatrix(0, 5) = "Jumlah"
.ColWidth(0) = 1305
.ColWidth(1) = 2000
.ColWidth(2) = 2000
.ColWidth(3) = 800
.ColWidth(4) = 2300
.ColWidth(5) = 1005
End With
End Sub
Private Sub product_grid_EnterCell()
product_grid.Cell(flexcpBackColor, product_grid.Row, 0, product_grid.Row, product_grid.Cols - 1) = &HFFFFC0
End Sub
Private Sub product_grid_LeaveCell()
If product_grid.Row > 0 Then product_grid.Cell(flexcpBackColor, product_grid.Row, 0, product_grid.Row, product_grid.Cols - 1) = vbWhite
End Sub
Private Sub Form_Activate()
Dim Atas As Long
Dim Kiri As Long
Atas = (Screen.Height - Me.Height) / 2
Kiri = (Screen.Width - Me.Width) / 2
Me.Move Kiri, Atas
End Sub
Private Sub load_objrecordset()
Set merna = New ADODB.Recordset
'mSQL = " Select *,'" & Cmb_SEARCH.Text & "' as [Title] from Product_View "
mSQL = "select * from Product_View"
With merna
.ActiveConnection = objConnection
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockBatchOptimistic
.Source = mSQL
.Open
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
If merna.State = adStateOpen Then
merna.Close
End If
Set merna = Nothing
End Sub
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|