lehongduc > 12-07-12, 10:21 AM
lehongduc > 16-07-12, 01:41 PM
Sub SetSourceRecForSubForm(mForm As Form, sForm As String)
Dim SQLst As String
Dim SQLrec As ADODB.Recordset
Dim tblName As String
Dim vSoCtu, stChema As String
vSoCtu = mForm!cmbSoCtu
If Not IsNull(vSoCtu) Then
tblName = "tblctunxct"
stChema = GetSchemaTable(tblName)
SQLst = "SELECT " & stChema & ".tbldmhanghoa.tenhanghoa, " & stChema & ".tblctunxct.*"
SQLst = SQLst & " FROM " & stChema & ".tbldmhanghoa INNER JOIN " & stChema & ".tblctunxct"
SQLst = SQLst & " ON " & stChema & ".tbldmhanghoa.mshh=" & stChema & ".tblctunxct.mshh"
SQLst = SQLst & " WHERE " & stChema & ".tblctunxct.soctu = '" & vSoCtu & "'"
Set SQLrec = ProcessRecordset(SQLst)
Set mForm(sForm).Form.Recordset = SQLrec
With mForm(sForm).Form
.Requery
!txtId.ControlSource = "id"
!txtMSHH.ControlSource = "mshh"
!txtTenHanghoa.ControlSource = "tenhanghoa"
!txtCapDvt.ControlSource = "dvt"
!txtDvt.ControlSource = "=IIF(not isnull(dvt),flookup('kihieu','tbldonvitinh','cap=' & [dvt]),'')"
!txtSoluong.ControlSource = "soluong"
!txtDongia.ControlSource = "dongia"
!chkCKTL.ControlSource = "lacktyle"
!txtMucCK.ControlSource = "mucck"
End With
‘Nhớ đóng Recordset đã gán cho SubForm bằng 2 dòng lệnh sau nhằm mục đích tiết kiệm tài nguyên hệ thống:
SQLrec.Close
Set SQLrec = Nothing
End If
End Sub
Như các Bạn đã thấy trong thủ tục trên, ngay sau khi đã gán Recordset SQLrec cho SubForm qua dòng lệnh:
[Code]
Set mForm(sForm).Form.Recordset = SQLrec
Sub SaveToInvoiceDetailFromForm(Optional InVoiceDetailId)
'Luu thong tin tren form vao tblctunxCT
'UpdateInvoiceDetail
On Error GoTo HandleError
Dim SQLst As String, tblName As String
Dim vId
Dim MucCK As Double, CKTL As Byte
Call OpenMyConnection
tblName = "tblctunxct"
With Me
vId = Me.txtDetailId
MucCK = Nz(.txtMucCK)
If IsNull(.chkCKTL) Then
CKTL = 0
Else
If .chkCKTL.Value = True Then
CKTL = 1
Else
CKTL = 0
End If
End If
If Not IsNull(vId) Then
SQLst = "UPDATE " & GetSchemaTable(tblName) & "." & tblName & " SET "
SQLst = SQLst & " soctu ='" & Trim(.cmbSoCtu) & "',"
SQLst = SQLst & " mshh =" & .cmbMSHH & ","
SQLst = SQLst & " dvt =" & .cmbDvt & ","
SQLst = SQLst & " soluong =" & .txtSoluong & ","
SQLst = SQLst & " dongia =" & .txtDongia & ","
SQLst = SQLst & " lacktyle =" & CKTL & ","
' SQLst = SQLst & " mucck =" & Format(MucCK, "#,###.0#")
SQLst = SQLst & " mucck =" & MucCK
SQLst = SQLst & " WHERE ("
SQLst = SQLst & " soctu='" & Trim(Me.cmbSoCtu) & "'"
SQLst = SQLst & " AND id=" & InVoiceDetailId
SQLst = SQLst & ")"
Else
SQLst = "INSERT INTO " & GetSchemaTable(tblName) & "." & tblName
SQLst = SQLst & "(soctu, mshh, dvt, soluong, dongia, lacktyle, mucck)"
SQLst = SQLst & " VALUES ("
SQLst = SQLst & " '" & Trim(.cmbSoCtu) & "',"
SQLst = SQLst & " " & .cmbMSHH & ","
SQLst = SQLst & " " & .cmbDvt & ","
SQLst = SQLst & " " & .txtSoluong & ","
SQLst = SQLst & " " & .txtDongia & ","
SQLst = SQLst & " " & CKTL & ","
SQLst = SQLst & " " & Nz(MucCK)
SQLst = SQLst & ")"
End If
End With
Debug.Print SQLst
MyConn.Execute SQLst
Call CloseMyConnection
HandleError:
If Err > 0 Then
GeneralErrorHandler Err.Number, Err.Description, NhapXuat_FORM, "SaveToInvoiceDetailFromForm"
Exit Sub
End If
End Sub
Private Sub SetComboRowSource(ComboName As String, RecSourceSt As String, stFilter As String)
'Nap RowSource cho ComboBox có tên qua biến ComboName
Dim SQLst As String
Dim SourceRec As ADODB.Recordset
SQLst = RecSourceSt & " WHERE " & stFilter 'ten LIKE N'%" & stFilter & "%'"
Set SourceRec = ProcessRecordset(SQLst)
Set Me(ComboName).Recordset = SourceRec
SourceRec.Close
Set SourceRec = Nothing
End Sub
Private Sub cmbKhachhang_KeyDown(KeyCode As Integer, Shift As Integer)
Dim srcSt As String, sCri As String
Dim tblName As String
Dim InputSt
'Set RowSource For CmbKhachhang
'SetComboRowSource
If KeyCode = vbKeyF4 Or (KeyCode = vbKeyDown And Shift = acAltMask) Then
InputSt = Me.cmbKhachhang.Text
tblName = "tblDanhsach"
srcSt = "SELECT * FROM " & GetSchemaTable(tblName) & "." & tblName
sCri = " ten LIKE N'%" & InputSt & "%'"
SetComboRowSource "cmbkhachhang", srcSt, sCri
End If
'
End Sub
Sub SaveToInvoiceFromForm(Optional InvoiceId)
'Luu thong tin tren form vao tblctunx
On Error GoTo HandleError
Dim SQLst As String, tblName As String
Dim vId
Call OpenMyConnection
tblName = "tblctunx"
With Me
vId = Me.txtId
If Not IsNull(vId) Then ‘Nếu giá trị của TextBox txtId không là Null nghĩa là Form đang hiển thị thông tin của chứng từ đang hiện hữu.
SQLst = "UPDATE " & GetSchemaTable(tblName) & "." & tblName & " SET "
SQLst = SQLst & " soctu ='" & .cmbSoCtu & "',"
SQLst = SQLst & " ngay ='" & Format$(.txtNgay, "dd-mmm-yy") & "',"
SQLst = SQLst & " msnv ='" & .cmbNghiepvu & "',"
SQLst = SQLst & " mskh ='" & .cmbKhachhang & "',"
SQLst = SQLst & " nguoigiaodich ='" & .txtNguoiGiaodich & "',"
SQLst = SQLst & " tsuatvat =" & .txtTsuat
SQLst = SQLst & " WHERE ("
SQLst = SQLst & " soctu='" & InvoiceId & "'"
SQLst = SQLst & ")"
Else ‘Nếu giá trị của TextBox txtId là Null nghĩa là Form đang hiển thị thông tin của chứng từ chờ lưu mới.
If IsNull(.cmbSoCtu) Then Exit Sub
SQLst = "INSERT INTO " & GetSchemaTable(tblName) & "." & tblName
SQLst = SQLst & "(soctu, ngay, msnv, mskh, tsuatvat)"
SQLst = SQLst & " VALUES ("
SQLst = SQLst & " '" & .cmbSoCtu & "',"
SQLst = SQLst & " '" & Format$(.txtNgay, "dd-mmm-yy") & "',"
SQLst = SQLst & " '" & .cmbNghiepvu & "',"
SQLst = SQLst & " '" & .cmbKhachhang & "',"
SQLst = SQLst & " '" & .txtNguoiGiaodich & "',"
SQLst = SQLst & " " & .txtTsuat
SQLst = SQLst & ")"
End If
End With
MyConn.Execute SQLst
Call CloseMyConnection
HandleError:
If Err > 0 Then
GeneralErrorHandler Err.Number, Err.Description, NhapXuat_FORM, "SaveToInvoiceFromForm"
Exit Sub
End If
End Sub
Sub LoadInvoiceInfoToForm(SoCtuSt)
Dim SQLst As String, SQLrec As ADODB.Recordset
Dim KHrec As ADODB.Recordset
Dim tblName As String, MsKH As Long
tblName = "tblctunx"
If IsNull(SoCtuSt) Then Exit Sub
SQLst = "SELECT * FROM " & GetSchemaTable(tblName) & "." & tblName
SQLst = SQLst & " WHERE soctu ='" & SoCtuSt & "'"
Set SQLrec = ProcessRecordset(SQLst)
'
If SQLrec.RecordCount > 0 Then
Set objKhachHang = New clsDanhba
With Me
.txtId = SQLrec!id
.txtNgay = SQLrec!ngay
.cmbNghiepvu = SQLrec!msnv
.txtTsuat = SQLrec!tsuatvat
.txtNguoiGiaodich = SQLrec!nguoigiaodich
MsKH = SQLrec!MsKH
SQLst = "SELECT * FROM " & GetSchemaTable("tblDanhsach") & ".tblDanhsach"
SQLst = SQLst & " WHERE danhbaid = " & MsKH
Set KHrec = ProcessRecordset(SQLst)
objKhachHang.PopulatePropertiesFromRecordset KHrec
.cmbKhachhang = MsKH
.cmbKhachhang.RowSourceType = "Value List"
.cmbKhachhang.RowSource = objKhachHang.Ten & ";" & MsKH
.txtDiachi = objKhachHang.Diachi
.txtPhone = objKhachHang.Dtvp
.txtMasoThue = objKhachHang.Msthue
KHrec.Close
Set KHrec = Nothing
'Dòng sau để cho nạp nguồn dữ liệu chi tiết hàng hóa tương ứng của chứng từ đã xác định
SetSourceRecForSubForm Me, "frmCtuNXCT"
End With
End If
'
SQLrec.Close
Set SQLrec = Nothing
End Sub
lehongduc > 16-07-12, 05:53 PM
Sub SaveToInvoiceFromForm(Optional InvoiceId)
'Luu thong tin tren form vao tblctunx
'UpdateOrInsert:
'+ True: Luu thong tin thay doi vao mau tin dang hien huu
'+ Flase: Them mau tin moi
'InvoiceId: so chung tu
'
On Error GoTo HandleError
Dim SQLst As String, tblName As String
Dim vId
Call OpenMyConnection
tblName = "tblctunx"
With Me
vId = Me.txtId
If Not IsNull(vId) Then
If IsNull(InvoiceId) Then Exit Sub
SQLst = "UPDATE " & GetSchemaTable(tblName) & "." & tblName & " SET "
SQLst = SQLst & " soctu ='" & .cmbSoCtu & "',"
SQLst = SQLst & " ngay ='" & Format$(.txtNgay, "dd-mmm-yy") & "',"
SQLst = SQLst & " msnv ='" & .cmbNghiepvu & "',"
'SQLst = SQLst & " mskh ='" & .cmbKhachhang & "'," 'Đây là dòng sai, vì mskh có kiểu numeric nhưng ở đây có 2 dấu nháy ở 2 đầu nên thành kiểu Text
SQLst = SQLst & " mskh =" & .cmbKhachhang & "," 'Đây là dòng đã được hiệu chỉnh cho đúng, bỏ dấu nháy ở 2 đầu
SQLst = SQLst & " nguoigiaodich = N'" & .txtNguoiGiaodich & "'," 'Và sẵn tiện sửa luôn dòng này để lưu được chuỗi Unicode
SQLst = SQLst & " tsuatvat =" & .txtTsuat
SQLst = SQLst & " WHERE ("
SQLst = SQLst & " soctu='" & InvoiceId & "'"
SQLst = SQLst & ")"
Else
If IsNull(.cmbSoCtu) Then Exit Sub
SQLst = "INSERT INTO " & GetSchemaTable(tblName) & "." & tblName
SQLst = SQLst & "(soctu, ngay, msnv, mskh, nguoigiaodich, tsuatvat)"
SQLst = SQLst & " VALUES ("
SQLst = SQLst & " '" & .cmbSoCtu & "',"
SQLst = SQLst & " '" & Format$(.txtNgay, "dd-mmm-yy") & "',"
SQLst = SQLst & " '" & .cmbNghiepvu & "',"
SQLst = SQLst & " " & .cmbKhachhang & ","
SQLst = SQLst & " N'" & .txtNguoiGiaodich & "',"
SQLst = SQLst & " " & .txtTsuat
SQLst = SQLst & ")"
End If
End With
MyConn.Execute SQLst
Call CloseMyConnection
'
LoadInvoiceInfoToForm Me.cmbSoCtu
HandleError:
If Err > 0 Then
GeneralErrorHandler Err.Number, Err.Description, NhapXuat_FORM, "SaveToInvoiceFromForm"
Exit Sub
End If
End Sub
Private Sub SetComboRowSource(ComboName As String, RecSourceSt As String, stFilter As String)
'Nap RowSource cho ComboBox
Dim SQLst As String
Dim SourceRec As ADODB.Recordset
SQLst = RecSourceSt & " WHERE " & stFilter 'ten LIKE N'%" & stFilter & "%'"
Set SourceRec = ProcessRecordset(SQLst)
'thêm 3 dòng kế bên dưới. Tôi viết kiểu With ... End With để phòng khi phải khai báo thêm gì nữa cho ComboBox
With Me(ComboName)
.RowSourceType = "Table/Query"
End With
Set Me(ComboName).Recordset = SourceRec
SourceRec.Close
Set SourceRec = Nothing
End Sub
lehongduc > 16-07-12, 06:21 PM
lehongduc > 17-07-12, 05:18 AM
Set mForm(sForm).Form.Recordset = SQLrec
mForm(sForm).Form.Recordset = SQLrec
lehongduc > 17-07-12, 02:02 PM
lehongduc > 17-07-12, 02:17 PM
Function fLookup(WhatField As String, WhatTable As String, CriSt As String)
On Error GoTo xulynull
Dim SrcRec As ADODB.Recordset
Dim srcSt As String
If Len(CriSt) = 0 Then Exit Function
srcSt = "SELECT TOP 1 " & WhatField & " FROM " & GetSchemaTable(WhatTable) & "." & WhatTable
srcSt = srcSt & " WHERE " & CriSt
Set SrcRec = ProcessRecordset(srcSt)
If SrcRec.RecordCount > 0 Then fLookup = Trim(SrcRec(WhatField))
SrcRec.Close
Set SrcRec = Nothing
Exit Function
xulynull:
If Err > 0 Then fLookup = Null
Exit Function
End Function
lehongduc > 18-07-12, 01:47 PM
lehongduc > 19-07-12, 08:26 AM
tanthuc > 04-10-12, 11:51 AM