VB开发的ERP系统

Private Sub CxbbGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
    Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
End Sub

Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)                '网格格式调整(Fixed)
  
    Select Case Button.Key
        Case "bcgs"                                          '保存表格格式
            Call Bcwggs(CxbbGrid, GridCode, GridStr())
        Case "hfmrgs"                                        '恢复默认格式
            Call Hfmrgs(CxbbGrid, GridCode, GridStr())
        Case "szxsxm"                                        '设置显示项目
            Call Szxsxm(CxbbGrid, GridCode)
    End Select

End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    
    Select Case Button.Key
        Case "ymsz"                                          '页面设置
            Dyymctbl.Show 1
        Case "yl"                                            '预 览
            Call bbyl(True)
        Case "dy"                                            '打 印
            Call bbyl(False)
        Case "cx"                                            '查 询
            LB_AdjustOutBillCond.Show 1
        Case "Bill"                                          '单 据
            Call CxbbGrid_DblClick
        Case "xz"                                            '新 增
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log("Chhs_AdjustOutEidt", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Call Sub_AddBill
        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)
    
    '调整工具条
    Call Sub_ToolBar
   
    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 Long                        '临时动态计数器
    
    '以下为自定义部分[
 
    If Int_QueryType = 0 Then   '0-"点确定按钮"查询
        With LB_AdjustOutBillCond
         
            '生成查询条件
            Str_QueryCondi = " where 1=1 "
            For Jsqte = 0 To 18
                Select Case Jsqte
                    Case 0  '仓库
                        If Trim(.LrText(0).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And a.whcode='" & Trim(.LrText(0).Tag) & "'"
                        End If
                    Case 1  '单据号(起始)
                        If Trim(.LrText(1).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And a.billnum>='" & Trim(.LrText(1).Text) & "'"
                        End If
                    Case 2  '单据号(终止)
                        If Trim(.LrText(2).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And a.billnum<= '" & Trim(.LrText(2).Text) & "'"
                        End If
                    Case 3  '查询日期范围(起始)
                        If Trim(.LrText(3).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And a.BillDate>='" & Trim(.LrText(3).Text) & "'"
                        End If
                    Case 4  '查询日期范围(终止)
                        If Trim(.LrText(4).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And a.BillDate<= '" & Trim(.LrText(4).Text) & "'"
                        End If
                    Case 5  '存货分类(Like)
                        If Trim(.LrText(5).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And a.invsortcode like '" & Trim(.LrText(5).Tag) & "%'"
                        End If
                    Case 6  '查询存货范围(起始)
                        If Trim(.LrText(6).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And a.mnumber>='" & Trim(.LrText(6).Text) & "'"
                        End If
                    Case 7  '查询存货范围(终止)
                        If Trim(.LrText(7).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And a.mnumber<= '" & Trim(.LrText(7).Text) & "'"
                        End If
                    Case 8  '客户
                        If Trim(.LrText(8).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and a.cuscode = '" & Trim(.LrText(8).Tag) & "'"
                        End If
                    Case 9  '部门
                        If Trim(.LrText(9).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and a.deptcode = '" & Trim(.LrText(9).Tag) & "'"
                        End If
                    Case 10  '出库类别
                        If Trim(.LrText(10).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and a.inoutclasscode = '" & Trim(.LrText(10).Tag) & "'"
                        End If
                End Select
            Next Jsqte
        End With
    Else
        '1-"刷新"查询
        If Str_QueryCondi = "" Then
            Str_QueryCondi = " where 1=2 "
        End If
    End If
     
    SqlStr = "SELECT * FROM Chhs_V_AdjustInOut a LEFT OUTER JOIN Gy_WhLimit ON " & _
            " a.Whcode = Gy_WhLimit.Whcode " & _
             Trim(Str_QueryCondi) & " and Gy_WhLimit.czybm='" & Xtczybm & "'" & _
            " and a.billcode='1302' Order By a.Period,a.whcode,a.Billdate,a.InOutAdjustMainId,a.InOutAdjustSubId"

    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("InOutAdjustMainId")                                                 '主表ID(主要用来查询定位用)
            CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("BillNum") & "")                    '单据号
            CxbbGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("WhName") & "")                     '仓库
            CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Format(.Fields("BillDate"), "yyyy-mm-dd")        '日期
            CxbbGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("CusName") & "")                    '客户
            CxbbGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("Deptname") & "")                   '部门
            CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("InoutClassName") & "")             '收发类别
            CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("PersonName") & "")                 '业务员
            CxbbGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("Maker") & "")                      '制单人
            CxbbGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("ChalkitupMan") & "")               '记帐人
            CxbbGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("Mnumber") & "")                    '存货编码
            CxbbGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("MName") & "")                      '存货名称
            CxbbGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = Trim(.Fields("Model") & "")                      '规格型号
            CxbbGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = Trim(.Fields("PrimaryUnitName") & "")            '计量单位
            CxbbGrid.TextMatrix(Jsqte, Sydz("015", GridStr(), Szzls)) = Trim(.Fields("kjyear") & "")                     '年度
            CxbbGrid.TextMatrix(Jsqte, Sydz("016", GridStr(), Szzls)) = Trim(.Fields("period") & "")                     '月份
            If .Fields("Emoney") <> 0 Then                                                                            '单重
                CxbbGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls)) = .Fields("Emoney")
            End If
            
            '<<]
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(Jsqte) = Sjhgd
     
            '动态集指针加1,同时将计数器加1(Fixed)
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With
    
    '输入合计
    With CxbbGrid
        If LB_AdjustInBillCond.Chk_Sum.Value = 1 Then
           .SubtotalPosition = flexSTBelow
           For Jsqte = Qslz To .Cols - 1
                If GridBoolean(Jsqte, 4) Then
                     .Subtotal flexSTSum, 0, Jsqte, , &HF7F3EC, , , , , True
                End If
           Next
           
           For Jsqte = .FixedRows To .Rows - 1
                If .IsSubtotal(Jsqte) Then
                    For Coljsq = Qslz To .Cols - 1
                        If Val(.TextMatrix(Jsqte, Coljsq)) = 0 And GridBoolean(Coljsq, 4) Then
                            .TextMatrix(Jsqte, Coljsq) = ""
                        End If
                    Next
                    .TextMatrix(Jsqte, 0) = .TextMatrix(Jsqte - 1, 0)
                    .TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = "    合计 "
                    .RowHeight(Jsqte) = Sjhgd
                End If
           Next
        End If
    End With
    
    ']以上为用户自定义部分

End Sub

Private Sub CxbbGrid_DblClick()                                              '用户双击网格调入相应单据
    
    Dim Rectemp As New ADODB.Recordset               '临时使用动态集

    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If

    SqlStr = "SELECT InOutAdjustMainId From Chhs_InOutAdjustMain Where InOutAdjustMainId=" & 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
                
            '填充查询单据标识
            XT_BillID = CxbbGrid.TextMatrix(CxbbGrid.Row, 0)
            Xtcdcsfz = Str_QueryCondi
            
            '设置单据处理为列表查询(修改)状态
            Xtcdcs = "2"
                
            '调入单据处理窗体
            DJ_AdjustOutBill.Show 1
            
        End If
    End With

End Sub

Private Sub Sub_AddBill()                                              '新增单据
Dim Rectemp As Recordset

    '系统操作日期不在当前会计年度
    If Not Xtyear = PGKjYear Then
        Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + ")之内,请重新登录!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    '系统操作日期是否在当前会计期间
    If Not Xtmm = PGNowmon Then
        Tsxx = "操作日期不在当前会计期间(" + Trim(Str(PGKjYear)) + "." + Trim(Str(PGNowmon)) + ")之内,请重新登录!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    With DJ_AdjustOutBill
   
        '设置单据处理为填制单据状态
        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_ToolBar()          '设置工具条按钮
    
    '无查询记录时，单据和删除按钮不可选
    With SzToolbar
        If CxbbGrid.Rows = CxbbGrid.FixedRows Then
            .Buttons("Bill").Enabled = False
        Else
            .Buttons("Bill").Enabled = True
        End If
    End With
    
End Sub
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