-

VB开发的ERP系统

            Key             =   "fh"
            ImageKey        =   "tc"
         EndProperty
      EndProperty
      BorderStyle     =   1
   End
End
Attribute VB_Name = "KF_FrmInList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**************************************************************************
'*    模 块 名 称 :入库汇总表
'*    功 能 描 述 :
'*    程序员姓名  : 赵宇光
'*    最后修改人  : 赵宇光
'*    最后修改时间:2001/12/18
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'**************************************************************************
Dim ReportTitle As String                '报表主标题

'以下为固定使用变量
Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
Dim GridCode As String                   '显示网格网格代码
Dim GridInf() As Variant                 '整个网格设置信息
Dim Tsxx As String                       '系统提示信息
Dim Qslz As Long                         '网格隐藏(非操作显示)列数
Dim Sjhgd As Double                      '网格数据行高度
Dim Sfxshjwg As Boolean                  '是否显示合计网格
Dim GridBoolean() As Boolean             '网格列信息(布尔型)
Dim GridStr()  As String                 '网格列信息(字符型)
Dim GridInt() As Integer                 '网格列信息(整型)
Dim Szzls As Integer                     '数组总列数(网格列数-1)
Private Sub Form_Resize()                '根据窗体大小来调整网格,标题栏大小
    On Error Resume Next
    With CxbbGrid
      .Width = Me.Width - 160
      .Height = Me.Height - .Top - 400
    End With
    With Pic_Title
      .Width = Me.Width - 160
    End With
    
    GsToolbar.Left = Me.Width - GsToolbar.Width - 160
End Sub
Private Sub Form_Load()                                                   '窗体装入
    
     '调入打印页面设置窗体
     
     XtReportCode = "KF_InList"
     Load Dyymctbl
     ReportTitle = "入库汇总表"
     
    '调整标题栏及网格、格式工具条位置
     Pic_Title.Left = 40
     Pic_Title.Top = SzToolbar.Top + SzToolbar.Height - 10
     CxbbGrid.Left = Pic_Title.Left
     CxbbGrid.Top = Pic_Title.Top + Pic_Title.Height + 20
    
    '调 入 网 格
     GridCode = "KF_InList"
     Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
     
     Qslz = GridInf(1)
     Sjhgd = GridInf(2)
     Sfxshjwg = GridInf(7)
     Szzls = CxbbGrid.Cols - 1

End Sub
Private Sub Form_Unload(Cancel As Integer)                                  '窗体卸载
   '卸载条件窗体
    KF_FrmInListQuery.UnloadCheck.Value = 1
    Unload KF_FrmInListQuery
   '卸载打印页面设置窗体
   Unload Dyymctbl
End Sub
Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)       '网格格式调整
    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"                                            '查 询
          KF_FrmInListQuery.Show 1
        Case "sx"                                            '刷 新
          Call Timer1_Timer
        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
   
   CxbbGrid.Redraw = True
    
   Xt_Wait.Hide
End Sub
Public Sub Adjust()
    Dim R As New Recordset
    
    Set R = Cw_DataEnvi.DataConnect.Execute("select colindex,coltitle1 from wm_grid where grid_code='kf_stockin_list' order by colid")
    
    If Not R.EOF Then
        R.MoveNext
        For jsq = 0 To CxbbGrid.Cols - 1
            Do While Not R.EOF
                If Trim(R.Fields("coltitle1")) = Trim(CxbbGrid.TextMatrix(0, jsq)) Then
                    GridStr(jsq, 1) = R.Fields("colindex")
                    Exit Do
                End If
                R.MoveNext
            Loop
            R.MoveFirst
            R.MoveNext
        Next jsq
    End If
    R.Close
    Set R = Nothing
End Sub

Private Sub Sub_Query()                                    '生成查询结果
    Dim Rec_Query As New ADODB.Recordset        '查询结果动态集
    Dim Str_QueryCondi As String                '用户录入查询条件
    Dim Sqlstr As String                        '查询字符串
    Dim Coljsq As Long                          '网格列计数器
    Dim jsqte As Long                           '临时动态计数器
    Dim Xtyear As Integer, Period As Integer
    Dim strGroup As String
    Dim dblSumQuan As Double
    Dim dblSumMoney As Double
    Dim tempCol As Integer
    Dim Rec_Mate As New Recordset
    Dim strWhCodeSelect As String
    Dim tmpJsq As Integer

    With KF_FrmInListQuery
    
        '显示隐藏相应网格列
        Select Case .Combo1.ListIndex
            Case 0      '物料
                Str_QueryCondi = "SELECT SUM(factreceiptquan) AS InQuan,SUM(EMoney) AS InMoney,MNumber,MName,Model,PrimaryUnitName FROM KF_V_InOutList WHERE InOutFlag=1"
                strGroup = " GROUP BY MNumber,MName,Model,PrimaryUnitName"
                tempCol = 2
                CxbbGrid.ColHidden(Sydz("001", GridStr(), Szzls)) = True            '供应商
                CxbbGrid.ColHidden(Sydz("002", GridStr(), Szzls)) = True            '部门
            Case 1      '供应商+物料
                Str_QueryCondi = "SELECT SUM(factreceiptquan) AS InQuan,SUM(EMoney) AS InMoney,MNumber,SupplierCode,SupplierName,MName,Model,PrimaryUnitName FROM KF_V_InOutList WHERE InOutFlag=1 AND SupplierCode IS NOT NULL"
                strGroup = " GROUP BY SupplierCode,SupplierName,MNumber,MName,Model,PrimaryUnitName"
                tempCol = 0
                CxbbGrid.ColHidden(Sydz("002", GridStr(), Szzls)) = True
                CxbbGrid.ColHidden(Sydz("001", GridStr(), Szzls)) = False            '供应商
            Case 2      '部门+物料
                Str_QueryCondi = "SELECT SUM(factreceiptquan) AS InQuan,SUM(EMoney) AS InMoney,MNumber,DeptCode,DeptName,MName,Model,PrimaryUnitName FROM KF_V_InOutList WHERE InOutFlag=1 AND DeptCode IS NOT NULL"
                strGroup = " GROUP BY DeptCode,DeptName,MNumber,MName,Model,PrimaryUnitName"
                tempCol = 1
                CxbbGrid.ColHidden(Sydz("001", GridStr(), Szzls)) = True
                CxbbGrid.ColHidden(Sydz("002", GridStr(), Szzls)) = False            '部门
        End Select
     
        '显示查询会计期间
        For jsqte = 1 To 7
            Select Case jsqte
              
                Case 1  '会计期间
                    If Trim(.Combo_Kjqj2.Text) <> "" Then
                        Xtyear = Val(Mid(Trim(.Combo_Kjqj2.Text), 1, 4))
                        Period = Val(Mid(Trim(.Combo_Kjqj2.Text), 6))
                        Str_QueryCondi = Str_QueryCondi & " AND kjyear=" & Xtyear & " and Period between " & Val(Mid(Trim(.Combo_Kjqj1.Text), 6)) & " and " & Period
                    End If
              
                Case 2   '仓库
                    strWhCodeSelect = ""
                    For tmpJsq = 0 To .Lst_Check.ListCount - 1
                        If .Lst_Check.Selected(tmpJsq) Then
                            strWhCodeSelect = strWhCodeSelect & "'" & Mid(Trim(.Lst_Check.List(tmpJsq)), 1, 4) & "',"
                        End If
                    Next tmpJsq
                    
                    Str_QueryCondi = Str_QueryCondi & " and WhCode in (" & Mid(Trim(strWhCodeSelect), 1, (Len(strWhCodeSelect) - 1)) & ")"
             
                Case 3   '物料分类
                    If Trim(.LrText(0).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " and invsortcode LIKE '" & Trim(.LrText(0).Tag) & "%'"
                    End If
                
                Case 4   '材料
                    If Trim(.LrText(1).Text) <> "" Then
                        If Trim(.LrText(2).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and mnumber between '" & Trim(.LrText(1).Text) & "' and '" & Trim(.LrText(2).Text) & "'"
                        Else
                            Str_QueryCondi = Str_QueryCondi & " and mnumber>='" & Trim(.LrText(1).Text) & "'"
                        End If
                    Else
                       If Trim(.LrText(2).Text) <> "" Then
                          Str_QueryCondi = Str_QueryCondi & " and mnumber<='" & Trim(.LrText(2).Text) & "'"
                       End If
                    End If

                Case 5   '供应商
                    If Trim(.LrText(3).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " and  suppliercode='" & Trim(.LrText(3).Tag) & "'"
                    End If
                    
                Case 6   '部门
                    If Trim(.LrText(4).Text) <> "" Then
                        Str_QueryCondi = Str_QueryCondi & " and  DeptCode='" & Trim(.LrText(4).Tag) & "'"
                    End If
                Case 7  '日期
                    If Trim(.LrText(5).Text) <> "" Then
                        If Trim(.LrText(6).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and billdate between '" & CDate(Trim(.LrText(5).Text)) & "' and '" & CDate(Trim(.LrText(6).Text)) & "'"
                        Else
                            Str_QueryCondi = Str_QueryCondi & " and billdate>='" & CDate(Trim(.LrText(5).Text)) & "'"
                        End If
                    Else
                       If Trim(.LrText(6).Text) <> "" Then
                          Str_QueryCondi = Str_QueryCondi & " and billdate<='" & CDate(Trim(.LrText(6).Text)) & "'"
                       Else
                       End If
                    End If
            End Select
        Next jsqte
    End With
    
    Label1 = "会计期间:   " & Trim(KF_FrmInListQuery.Combo_Kjqj1.Text) & "----" & Trim(KF_FrmInListQuery.Combo_Kjqj2.Text)
    dblSumQuan = 0
    dblSumMoney = 0
    
    Str_QueryCondi = Str_QueryCondi & strGroup
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Str_QueryCondi)
    
    CxbbGrid.Rows = CxbbGrid.FixedRows
    jsqte = CxbbGrid.FixedRows
    With Rec_Query
        If Not .EOF Then
            .MoveFirst
            Do While Not .EOF
                CxbbGrid.AddItem ""
                If CxbbGrid.ColHidden(Sydz("001", GridStr(), Szzls)) = False Then
                    CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("SupplierName") & "")      '供应商
                End If
                If CxbbGrid.ColHidden(Sydz("002", GridStr(), Szzls)) = False Then
                    CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("DeptName") & "")          '部门
                End If
                CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("MNumber"))                    '物料编码
                CxbbGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("MName"))                      '物料名称
                CxbbGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("Model") & "")                 '规格型号
                CxbbGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("PrimaryUnitName"))            '计量单位
                If Val(.Fields("InQuan")) <> 0 Then
                    CxbbGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = Val(.Fields("InQuan"))                  '入库数量
                    dblSumQuan = dblSumQuan + Val(.Fields("InQuan"))
                Else
                    CxbbGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = ""
                End If
                If Val(.Fields("InMoney")) <> 0 Then
                    CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = Val(.Fields("InMoney"))                 '入库金额
                    dblSumMoney = dblSumMoney + Val(.Fields("InMoney"))
                Else
                    CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = ""
                End If
                
                CxbbGrid.RowHeight(jsqte) = Sjhgd
                jsqte = jsqte + 1
                .MoveNext
            Loop
        End If
    End With
    CxbbGrid.AddItem ""
    CxbbGrid.TextMatrix(jsqte, tempCol) = "合计"
    If dblSumQuan <> 0 Then
        CxbbGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = dblSumQuan                                          '合计数量
    End If
    If dblSumMoney <> 0 Then
        CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = dblSumMoney                                         '合计金额
    End If
    CxbbGrid.RowHeight(CxbbGrid.Rows - 1) = Sjhgd

 ']以上为用户自定义部分
   
End Sub

Private Sub CxbbGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)
    '如果结束列小于用户定义网格开始列，则结束列=用户定义网格开始列
    '因为开始列以前的列都是隐藏列，由于要把当前开始移动列移动到隐藏列上
    '所以控件自动把隐藏列变为显示列，这样在刷新数据时，会把隐藏列上的数据
    '显示出来，并且，由于开始列以前的隐藏列在XT_Grid中，不对应逻辑值，所以在保存
    '网格格式时会出错
    If Col > Position Then
      If Position < GridInf(1) Then Position = GridInf(1)
    Else
      If Col < GridInf(1) Then Col = GridInf(1)
    End If
    Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
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 = 2                                          '报 表 小 标 题 行 数
    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(2) = Space(5) + Fun_FormatOutPut(Trim(Label1), 30)
    
    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