VB开发的ERP系统

    Select Case Button.Key
    Case "ymsz"                                          '页面设置
        Dyymctbl.Show 1
    Case "yl"                                            '预 览
        Call bbyl(True)
    Case "dy"                                            '打 印
        Call bbyl(False)
    Case "cx"                                            '查 询
        Tr_HoldListcxtj.Show 1
    Case "Bill"                                          '单 据
        Call CxbbGrid_DblClick
    Case "xz"                                            '新 增
        '判断用户是否有此功能执行权限,如有则写上机日志(进入)
         If Not Security_Log("tr_hold_edit", Xtczybm, 1, True) Then
            Exit Sub
         End If
       
        Call Sub_AddBill
    Case "sc"                                            '删 除
        '判断用户是否有此功能执行权限,如有则写上机日志(进入)
         If Not Security_Log("tr_hold_edit", Xtczybm, 1, True) Then
            Exit Sub
         End If
       
        Call Sub_DeleteBill
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
    End Select
    
End Sub

Private Sub Timer1_Timer()                                 '在窗体激活后调入查询程序
    
    Timer1.Enabled = False
    Xt_Wait.Show
    Xt_Wait.Refresh
    
    '加快显示速度
    CxbbGrid.Redraw = False
    
    '生成查询结果
    Call Sub_Query(0)
    
    CxbbGrid.Redraw = True
    
    Xt_Wait.Hide
    
End Sub

Private Sub Sub_Query(Int_QueryType As Integer)                                     '生成查询结果(Define)
    
    '过程参数:Int_QueryType 0-"点确定按钮"查询  1-"刷新"查询
    
    Dim Rec_Query As New ADODB.Recordset        '查询结果动态集
    Dim Coljsq As Long                          '网格列计数器
    Dim jsqte As Integer                       '临时动态计数器
    
    '以下为自定义部分[
    
    If Int_QueryType = 0 Then   '0-"点确定按钮"查询
        With Tr_HoldListcxtj
            
            '生成查询条件
            Str_QueryCondi = " where 1=1 "
            
            If .JiText(0) <> "____-__-__ __:__" Then
                Str_QueryCondi = Str_QueryCondi & " and holdtime  >= '" & .JiText(0) & "' "
            End If
            If .JiText(1) <> "____-__-__ __:__" Then
                Str_QueryCondi = Str_QueryCondi & " and holdtime  <= '" & .JiText(1) & "' "
            End If
            If .JiText(2) <> "____-__-__ __:__" Then
                Str_QueryCondi = Str_QueryCondi & " and holdendtime  >= '" & .JiText(2) & "' "
            End If
            If .JiText(3) <> "____-__-__ __:__" Then
                Str_QueryCondi = Str_QueryCondi & " and holdendtime  <= '" & .JiText(3) & "' "
            End If
            
            For jsqte = 0 To 2
                Select Case jsqte
                Case 0  '货物运单号
                    If Trim(.LrText(0).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " And ApplyCode='" & Trim(.LrText(0).Text) & "'"
                    End If
                Case 1  '车号
                    If Trim(.LrText(1).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " and vehiclenum = '" & Trim(.LrText(1).Text) & "'"
                    End If
                Case 2  '货物编码
                    If Trim(.LrText(2).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " and mnumber = '" & Trim(.LrText(2).Text) & "'"
                    End If
                End Select
            Next jsqte
            If .Opt_Check(1).Value Then
                Str_QueryCondi = Str_QueryCondi & " and  Checker='' "
            ElseIf .Opt_Check(2).Value Then
                Str_QueryCondi = Str_QueryCondi & " and  Checker<>'' "
            End If
        End With
    Else
        '1-"刷新"查询
        If Str_QueryCondi = "" Then
            Str_QueryCondi = " where 1=2 "
        End If
    End If
    
    Sqlstr = "SELECT * from Tr_V_Hold_List" & _
    Str_QueryCondi & " Order By Holddate,Holdnum,VehicleNum"
    
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With Rec_Query
        CxbbGrid.Rows = CxbbGrid.FixedRows
        jsqte = CxbbGrid.FixedRows
        Do While Not .EOF
            CxbbGrid.AddItem ""
            '[>>自定义填充内容
            CxbbGrid.TextMatrix(jsqte, 0) = .Fields("HoldMainId")
            CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), szzls)) = Format(.Fields("HoldDate") & "", "yyyy-mm-dd")                 '日期
            CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), szzls)) = Trim(.Fields("HoldNum") & "")                                  '调装单号
            CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), szzls)) = Trim(.Fields("vehiclenum") & "")                               '车号
            CxbbGrid.TextMatrix(jsqte, Sydz("004", GridStr(), szzls)) = Trim(.Fields("ApplyCode") & "")                                '货物运单号
            CxbbGrid.TextMatrix(jsqte, Sydz("005", GridStr(), szzls)) = Trim(.Fields("mnumber") & "")                                  '货物编码
            CxbbGrid.TextMatrix(jsqte, Sydz("006", GridStr(), szzls)) = Trim(.Fields("mName") & "")                                    '货物名称
            CxbbGrid.TextMatrix(jsqte, Sydz("007", GridStr(), szzls)) = Trim(.Fields("Model") & "")                                    '型号
            CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), szzls)) = Val(.Fields("quantity"))                                       '吨位
            CxbbGrid.TextMatrix(jsqte, Sydz("009", GridStr(), szzls)) = Format(.Fields("Holdtime") & "", "yyyy-mm-dd hh:mm")           '要求调装时间
            If Not IsNull(.Fields("holdendtime")) Then
                CxbbGrid.TextMatrix(jsqte, Sydz("010", GridStr(), szzls)) = Format(.Fields("holdendtime") & "", "yyyy-mm-dd hh:mm")    '调装完毕时间
            End If
            CxbbGrid.TextMatrix(jsqte, Sydz("011", GridStr(), szzls)) = Trim(.Fields("holdman") & "")                                  '负责人
            CxbbGrid.TextMatrix(jsqte, Sydz("012", GridStr(), szzls)) = Trim(.Fields("remark") & "")                                   '备注
            '<<]
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(jsqte) = Sjhgd
            
            '动态集指针加1,同时将计数器加1(Fixed)
            .MoveNext
            jsqte = jsqte + 1
        Loop
    End With
    
    ']以上为用户自定义部分
    
End Sub

Private Sub CxbbGrid_DblClick()                                              '用户双击网格调入相应单据
    
    Dim RecTemp As New ADODB.Recordset               '临时使用动态集
    '当第一次查询结果为空时,判断总记录行是否与固定行数相同,如相同则出现错误(双表头出现此情况)
    If CxbbGrid.Rows = CxbbGrid.FixedRows Then
        Exit Sub
    End If
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
    
    Sqlstr = "SELECT HoldMainId From Tr_HoldMain Where HoldMainId=" & Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If .EOF Then
            Tsxx = "此货物运单已被其他用户删除!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        Else
            '调入单据处理窗体
            With Tr_Hold
                
                '填充查询单据标识
                XT_BillID = CxbbGrid.TextMatrix(CxbbGrid.Row, 0)
                Xtcdcsfz = Str_QueryCondi
                
                '设置单据处理为列表查询(修改)状态
                Xtcdcs = "2"
                .Show 1
            End With
            If Xtfhcs = "1" Then
                Tsxx = "货物运单发生变化,是否刷新货物运单列表?"
                yhAnswer = Xtxxts(Tsxx, 2, 2)
                If yhAnswer = 1 Then
                    Xt_Wait.Show
                    Xt_Wait.Refresh
                    
                    '加快显示速度
                    CxbbGrid.Redraw = False
                    
                    '生成查询结果
                    Call Sub_Query(1)
                    
                    CxbbGrid.Redraw = True
                    Xt_Wait.Hide
                End If
            End If
        End If
    End With
    
End Sub

Private Sub Sub_AddBill()                                              '新增单据
    
    With Tr_Hold
        
        '设置单据处理为填制单据状态
        Xtcdcs = "1"
        
        .Show 1
    End With
    
    If Xtfhcs = "1" Then
        Tsxx = "货物运单发生变化,是否刷新货物运单列表?"
        yhAnswer = Xtxxts(Tsxx, 2, 2)
        If yhAnswer = 1 Then
            Xt_Wait.Show
            Xt_Wait.Refresh
            
            '加快显示速度
            CxbbGrid.Redraw = False
            
            '生成查询结果
            Call Sub_Query(1)
            
            CxbbGrid.Redraw = True
            Xt_Wait.Hide
        End If
    End If
    
End Sub

Private Sub Sub_DeleteBill()                                            '删除选中当前销售订单
    
    Dim YAnswer As Integer
    Dim Lng_BillID As Long           '单据标识
    Dim str_TempSql As String
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
    
    Tsxx = "请确认是否删除当前货物运单?"
    yhAnswer = Xtxxts(Tsxx, 2, 2)
    
    If yhAnswer = 1 Then
        '1.判断当前销售订单是否允许删除
        If Not Fun_AllowDelete Then
            Exit Sub
        End If
        
        '2.删除单据所有内容
        Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
        On Error GoTo Swcwcl
        Cw_DataEnvi.DataConnect.BeginTrans
        '删除铁运排它表的相应记录
        str_TempSql = "delete tr_nowaccount where childid in (select holdsubid from tr_holdsub where holdmainid= " & Lng_BillID & ") and vouchernum=9 "
        Cw_DataEnvi.DataConnect.Execute (str_TempSql)
        '删除子表、主表
        Cw_DataEnvi.DataConnect.Execute ("Delete Tr_HoldSub Where HoldMainId=" & Lng_BillID)         '删除单据子表内容
        Cw_DataEnvi.DataConnect.Execute ("Delete Tr_HoldMain Where HoldMainId=" & Lng_BillID)        '删除单据主表内容
        Cw_DataEnvi.DataConnect.CommitTrans
        
        '删除网格中单据数据
        jsqte = CxbbGrid.FixedRows
        Do While jsqte <= CxbbGrid.Rows - 1
            If Val(CxbbGrid.TextMatrix(jsqte, 0)) = Lng_BillID Then
                CxbbGrid.RemoveItem (jsqte)
            Else
                jsqte = jsqte + 1
            End If
        Loop
    Else
        Exit Sub
    End If
    Exit Sub
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "删除销售订单过程中出现未知错误,程序自动恢复删除前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
    
End Sub

Private Function Fun_AllowDelete() As Boolean                                        '判断当前单据是否允许删除
    
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '查询字符串
    Dim Lng_BillID As Long                 '单据ID
    
    Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    Sqlstr = "Select Checker From Tr_HoldMain Where HoldMainId=" & Lng_BillID
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If Not .EOF Then
            If Trim(.Fields("Checker") & "") <> "" Then
                Tsxx = "该货物运单已审核确认,不能删除!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
        End If
    End With
    Fun_AllowDelete = True
    
End Function

Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
    
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 1                                          '报 表 小 标 题 行 数
    Bbbwhgs = 0                                          '报 表 表 尾 行 数
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    Bbzbt = ReportTitle
    Bbxbt(1) = ""
    bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
    Call Scyxsjb(CxbbGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If
    
End Sub