⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 clsorder.cls

📁 一个OA办公自动化管理系统
💻 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 + -