?? cgshdh.cls
字號(hào):
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CgShdh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'QQ:75347626
'MSN:whailin2000@hotmail.com
Option Explicit
Dim m_Kh As Kh
Dim m_CgShds As CgShds
Dim m_CgShdhType As Integer
Dim m_CgShdhDocno As String
Dim m_CgShdhDat As String
Dim m_CgShdh_KhCode As String
Dim m_CgShdh_Khno As Double
Dim m_CgShdhSysDat As String
Dim m_CgShdhSysTime As String
Dim m_CgShdhNo As Double
Dim m_CgShdhId As Integer
Dim m_CgShdhKey As Double
Private Sub Class_Initialize()
m_CgShdhId = -1
End Sub
Public Property Get Name() As String
Name = "CgShdh"
End Property
Public Property Get CgShdhId() As Integer
CgShdhId = m_CgShdhId
End Property
Public Property Get CgShdhKey() As Double
CgShdhKey = m_CgShdhKey
End Property
Public Property Get Kh() As Kh
If m_Kh Is Nothing Then
Set m_Kh = New Kh
m_Kh.Requery "", m_CgShdh_Khno
End If
Set Kh = m_Kh
End Property
Public Property Get CgShds() As CgShds
If m_CgShds Is Nothing Then
Set m_CgShds = New CgShds
m_CgShds.Fillbydb Me
End If
Set CgShds = m_CgShds
End Property
Public Property Get CgShdhType() As Integer
CgShdhType = m_CgShdhType
End Property
Public Property Get CgShdhDocno() As String
CgShdhDocno = m_CgShdhDocno
End Property
Public Property Get CgShdhDat() As String
CgShdhDat = m_CgShdhDat
End Property
Public Property Get CgShdh_Khno() As Double
CgShdh_Khno = m_CgShdh_Khno
End Property
Public Property Get CgShdhSysDat() As String
CgShdhSysDat = m_CgShdhSysDat
End Property
Public Property Get CgShdhSysTime() As String
CgShdhSysTime = m_CgShdhSysTime
End Property
Public Property Get CgShdhNo() As Double
CgShdhNo = m_CgShdhNo
End Property
Public Property Let CgShdhId(vCgShdhId As Integer)
m_CgShdhId = vCgShdhId
End Property
Public Property Let CgShdhKey(vCgShdhKey As Double)
m_CgShdhKey = vCgShdhKey
End Property
Public Property Let CgShdhType(vCgShdhType As Integer)
If vCgShdhType <> 1 And vCgShdhType <> 2 Then
Err.Raise vbObjectError + 1, , "收貨單類型只能為1-采購收貨單,2-采購?fù)素泦危?quot;
Exit Property
End If
m_CgShdhType = vCgShdhType
End Property
Public Property Let CgShdhDocno(vCgShdhDocno As String)
If Trim(vCgShdhDocno) = "" Then
Err.Raise vbObjectError + 1, , "收貨單號(hào)不能為空!"
Exit Property
End If
If m_CgShdhDocno <> vCgShdhDocno Then
Dim Rs As ADODB.Recordset
Set Rs = Conn.Execute("SELECT * FROM CgShdHREC WHERE CgShdHDOCNO='" & vCgShdhDocno & "'")
If Not Rs.EOF Then
Rs.Close
Set Rs = Nothing
Err.Raise vbObjectError + 1, , "收貨單號(hào)已經(jīng)存在!"
Exit Property
End If
Rs.Close
Set Rs = Nothing
End If
m_CgShdhDocno = vCgShdhDocno
End Property
Public Property Let CgShdhDat(vCgShdhDat As String)
If Trim(vCgShdhDat) = "" Then
Err.Raise vbObjectError + 1, , "收貨日期不能為空!"
Exit Property
End If
m_CgShdhDat = vCgShdhDat
End Property
Public Property Let CgShdh_KhCode(vCgShdh_KhCode As String)
If Trim(vCgShdh_KhCode) = "" Then
Err.Raise vbObjectError + 1, , "供應(yīng)商編碼不能為空!"
Exit Property
End If
If m_CgShdh_KhCode <> vCgShdh_KhCode Then
Dim Rs As ADODB.Recordset
Set Rs = Conn.Execute("SELECT KHNO FROM KHREC WHERE KHCODE='" & vCgShdh_KhCode & "'")
If Rs.EOF Then
Rs.Close
Set Rs = Nothing
Err.Raise vbObjectError + 1, , "錄入的供應(yīng)商編碼不存在!"
Exit Property
End If
m_CgShdh_Khno = Rs!KhNo
Rs.Close
Set Rs = Nothing
End If
m_CgShdh_KhCode = vCgShdh_KhCode
End Property
Public Sub Save()
On Error GoTo Errorhandle
If CgShds.Count = 0 Then
On Error GoTo 0
Err.Raise vbObjectError + 1, , "單據(jù)無明細(xì)行,不能存盤!"
Exit Sub
End If
If m_CgShdhId = -1 Then
Cmd.CommandText = "{CALL CgShdHREC_INSERT(?,?,?,?,?,?,?)}"
Cmd(0) = m_CgShdhType
Cmd(1) = m_CgShdhDocno
Cmd(2) = m_CgShdhDat
Cmd(3) = m_CgShdh_Khno
Cmd(4).Direction = adParamOutput 'CgShdhSysDate
Cmd(5).Direction = adParamOutput 'CgShdhSysTime
Cmd(6).Direction = adParamOutput 'CgShdhNo
Else
Cmd.CommandText = "{CALL CgShdhREC_UPDATE(?,?,?,?)}"
Cmd(0) = m_CgShdhNo
Cmd(1) = m_CgShdhDocno
Cmd(2) = m_CgShdhDat
Cmd(3) = m_CgShdh_Khno
End If
Conn.BeginTrans
Cmd.Execute
If m_CgShdhId = -1 Then
m_CgShdhNo = Cmd(6)
End If
CgShds.Save Me
Conn.CommitTrans
If m_CgShdhId = -1 Then
m_CgShdhSysDat = Cmd(4)
m_CgShdhSysTime = Cmd(5)
m_CgShdhId = 1
End If
Exit Sub
Errorhandle:
Conn.RollbackTrans
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Public Sub Del(Optional mMxDel As Integer = 0)
On Error GoTo Errorhandle
Cmd.CommandText = "{CALL CgShdHREC_DELETE(?)}"
Cmd(0) = m_CgShdhNo
If mMxDel = 0 Then
Conn.BeginTrans
End If
Cmd.Execute
If mMxDel = 0 Then
Conn.CommitTrans
End If
Exit Sub
Errorhandle:
If mMxDel = 0 Then
Conn.RollbackTrans
End If
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Public Function Requery(vCgShdhDocno As String, Optional vCgShdhno As Double = 0) As Integer
Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
Requery = -1
Set mRs = Conn.Execute("SELECT CgShdHTYPE,CgShdHDOCNO,CgShdHDAT,CgShdH_KHCODE=KHCODE,CgShdH_KHNO,CgShdHSYSDAT,CgShdHSYSTIME,CgShdHNO FROM CgShdHREC,KHREC WHERE (CgShdHDOCNO='" & vCgShdhDocno & "' OR CgShdHNO=" & CStr(vCgShdhno) & ") AND KHNO=CgShdH_KHNO")
If Not mRs.EOF Then
BatchLet mRs!CgShdhType, mRs!CgShdhDocno, mRs!CgShdhDat, mRs!CgShdh_KhCode, mRs!CgShdh_Khno, mRs!CgShdhSysDat, mRs!CgShdhSysTime, mRs!CgShdhNo
End If
Set mRs = Nothing
Exit Function
Errorhandle:
Set mRs = Nothing
Err.Raise vbObjectError + 1, , Err.Description
End Function
Public Sub BatchLet(ParamArray Properties() As Variant)
m_CgShdhType = Properties(0)
m_CgShdhDocno = Properties(1)
m_CgShdhDat = Properties(2)
m_CgShdh_KhCode = Properties(3)
m_CgShdh_Khno = Properties(4)
m_CgShdhSysDat = Properties(5)
m_CgShdhSysTime = Properties(6)
m_CgShdhNo = Properties(7)
m_CgShdhId = 1
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -