📄 clsorder.cls
字号:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 1 'vbDataSource
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsOrder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' 要做: 声明本地的 ADO Recordset 对象。例如:
Private rstCache As ADODB.Recordset
Attribute rstCache.VB_VarHelpID = -1
Private ParentItem As String
Dim arrField()
Private Sub Class_GetDataMember(DataMember As String, Data As Object)
'要做: 返回基于 DataMember 的相应的 recordset。例如:
Select Case DataMember
Case "" ' Default
Set Data = rstCache
Case Else ' Default
Set Data = rstCache
End Select
End Sub
Private Sub Class_Initialize()
'dbcn
Dim arrFieldColMax As String, i As Integer
'ReDim arrField(arrFieldColMax, 1) As String
' 创建记录集实例
Set rstCache = New ADODB.Recordset
' 设置记录集属性
With rstCache
.Fields.Append "Inventory_ID", adVarChar, 50, adFldKeyColumn ' 物料编号
.Fields.Append "Description", adVarChar, 100, adFldIsNullable ' 物料名称
.Fields.Append "Unit", adVarChar, 20, adFldIsNullable ' 单位
.Fields.Append "Style", adVarChar, 50, adFldIsNullable ' 规格
.Fields.Append "PlanPrice", adCurrency '计划价格
.Fields.Append "Price", adCurrency ' 单价
'.Fields.Append "Size_Type", adBigInt
.Fields.Append "Box_ID", adVarChar, 50, adFldIsNullable ' 容器编号
.Fields.Append "Project", adVarChar, 50, adFldIsNullable ' 相关单据号
.Fields.Append "CurrencyType", adVarChar, 20 ' 货币类型
.Fields.Append "ExchangeRate", adCurrency ' 汇率
.Fields.Append "PlanQty", adCurrency ' 计划数量
.Fields.Append "Qty", adCurrency ' 数量
.Fields.Append "TotalQty", adCurrency ' 合计数量
.Fields.Append "Employee", adVarChar, 50, adFldIsNullable ' 业务员1
.Fields.Append "Amount", adCurrency ' 金额
.Fields.Append "Amount_tax", adCurrency ' 含税金额
.Fields.Append "Amount_without_tax", adCurrency ' 不含税金额
.Fields.Append "TaxRate", adCurrency ' 税率
.Fields.Append "Dis_Amount", adCurrency ' 折扣后金额
.Fields.Append "Dis_type", adVarChar, 20, adFldIsNullable ' 折扣类型
.Fields.Append "Dis_Byco", adCurrency ' 折扣分摊
.Fields.Append "Dis_Buckle", adCurrency ' 折扣率/或折扣后单价
.Fields.Append "CardNo", adVarChar, 50, adFldIsNullable ' 卡号
.Fields.Append "ReasonID", adVarChar, 50, adFldIsNullable ' 原因代码
.Fields.Append "Summary", adVarChar, 50, adFldIsNullable ' 说明
.Fields.Append "Buckle", adCurrency
For i = 1 To 30
.Fields.Append "Q" & Format(Trim(i), "00"), adCurrency ' 配码
Next
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
.Open
End With
End Sub
Public Sub DellrstCache()
Initialize
End Sub
Public Property Get GetOrderNo() As Variant
' GetOrderNo = [OrderNo]
End Property
Public Function Recordset() As Recordset
Set Recordset = rstCache
End Function
Public Property Let letOrderNo(ByVal vNewValue As Variant)
letOrderNo = vNewValue
End Property
Public Function SelectSize() As String
Dim i As Integer
For i = 1 To 30
SelectSize = SelectSize & ",Q" & Format(i, "00")
Next
SelectSize = SelectSize & " FROM "
End Function
Public Function GetData(BillNO As String, islocal As Integer) As Integer
GetData = 0
On Error GoTo Err_GetData
DellrstCache
Dim rstTable As Recordset, i As Integer
Set rstTable = New Recordset
If islocal = 0 Then
rstTable.Open " SELECT Local_Inventory_Evidence_Detail.*, Description, Type, Size_Type, Style, Unit" _
& " FROM Inventory RIGHT JOIN Local_Inventory_Evidence_Detail ON Inventory.Inventory_ID = Local_Inventory_Evidence_Detail.Inventory_ID" _
& " Where Evidence_Number='" & BillNO & "' ", GetCNLocal, adOpenStatic, adLockReadOnly
Else
rstTable.Open " SELECT Inventory_Evidence_Detail.*, Description, Type, Size_Type, Style, Unit" _
& " FROM Inventory RIGHT JOIN Inventory_Evidence_Detail ON Inventory.Inventory_ID = Inventory_Evidence_Detail.Inventory_ID" _
& " Where Evidence_Number='" & BillNO & "' ", GetCNClient, adOpenStatic, adLockReadOnly
End If
With rstTable
If .RecordCount = 0 Then
GetData = 1
Exit Function
End If
.MoveFirst
Do Until .EOF
rstCache.AddNew
For i = 0 To rstCache.Fields.Count - 1
If rstCache.Fields(i).name <> "TotalQty" Then
rstCache.Fields(i).Value = .Fields(rstCache.Fields(i).name).Value
End If
Next
rstCache.Update
DoEvents
.MoveNext
Loop
End With
GetData = 1
Exit Function
Err_GetData:
GetData = 0
MisMsg "GetData Error: " & Err.Description
Exit Function
End Function
Public Function MaxOrderBy() As Integer
MaxOrderBy = 0
With rstCache
If .RecordCount Then
.MoveFirst
Do Until .EOF
If ![F11] > MaxOrderBy Then
MaxOrderBy = ![F11]
End If
.MoveNext
Loop
End If
End With
End Function
Public Function SaveData(BillNO As String, Optional islocal As Integer = 0) As Integer
SaveData = 0
On Error GoTo Err_SaveData
Dim rstTable As Recordset, i As Integer
Set rstTable = New Recordset
If islocal = 0 Then
GetCNLocal.Execute "Delete From Local_Inventory_Evidence_Detail Where Evidence_Number='" & BillNO & "'"
rstTable.Open "Select * From Local_Inventory_Evidence_Detail Where Evidence_Number='" & BillNO & "'", GetCNLocal, adOpenStatic, adLockBatchOptimistic
Else
GetCNClient.Execute "Delete From Inventory_Evidence_Detail Where Evidence_Number='" & BillNO & "'"
rstTable.Open "Select * From Inventory_Evidence_Detail Where Evidence_Number='" & BillNO & "'", GetCNClient, adOpenStatic, adLockBatchOptimistic
End If
With rstTable
If rstCache.RecordCount = 0 Then Exit Function
rstCache.MoveFirst
Do Until rstCache.EOF
.AddNew
For i = 0 To .Fields.Count - 1
'MsgBox rstCache.Fields(.Fields(i).Name)
If .Fields(i).name <> "ID" Then
If .Fields(i).name = "Evidence_Number" Then
.Fields("Evidence_Number").Value = BillNO
Else
.Fields(i).Value = rstCache.Fields(.Fields(i).name).Value
End If
End If
Next
rstCache.MoveNext
Loop
.UpdateBatch
End With
GetCNLocal.Execute "Delete From Local_Inventory_Evidence_Detail Where Qty=0"
SaveData = 1
Exit Function
Err_SaveData:
SaveData = 0
MisMsg "SaveData Error:" & Err.Description
Exit Function
End Function
Public Sub Initialize()
Class_Initialize
End Sub
Public Sub AddNew()
If rstCache.EOF Then
rstCache.AddNew
rstCache![Inventory_ID] = ""
ElseIf rstCache.EditMode = adEditAdd Then
rstCache.AddNew
rstCache![Inventory_ID] = ""
End If
rstCache.Update
End Sub
Private Sub Class_Terminate()
rstCache.Close
Set rstCache = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -