i-

VB开发的ERP系统

'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'**************************************************************************
Dim ReportTitle As String                '报表主标题
Dim Str_QueryCondi As String             '用户录入查询条件
Dim Rec_BillID As New ADODB.Recordset    '用户查询单据ID动态集
Dim Bln_CancelPrint As Boolean           '用户是否取消打印
Dim Bln_Printing As Boolean              '用户是否正在打印

'以下为固定使用变量
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)
Dim adoMate As New ADODB.Recordset
Dim adoQuery As New ADODB.Recordset
Public Bln As Boolean

Private Sub Form_Resize()                '根据窗体大小来调整网格,标题栏大小(Fixed)
    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 - 140

End Sub

Private Sub Form_Load()                                                   '窗体装入
  
    '调入打印页面设置窗体
    ReportTitle = "材料台帐"
    XtReportCode = "KF_MateAcc"
    Load Dyymctbl
      
    '调整标题栏及网格、格式工具条位置(Fixed)
    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
     
    '调 入 网 格(Fixed)
    GridCode = "KF_StockAcc"
    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_FrmMateAccCxtj.UnloadCheck.Value = 1
    Unload KF_FrmMateAccCxtj
    Unload KF_FrmDigest
    '卸载打印页面设置窗体
    Unload Dyymctbl

End Sub

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 "ld"
            Call Sub_Lxdy
        Case "cx"                                            '查 询
            KF_FrmMateAccCxtj.Show 1
        Case "Bill"
            Call CxbbGrid_DblClick
        Case "zy"
            If adoMate.State = 1 Then
                If adoMate.RecordCount > 0 Then
                    KF_FrmDigest.Label1.Caption = "3"
                    KF_FrmDigest.Show 1
                    If Not Bln Then
                        If adoMate.EOF Then
                            adoMate.MoveLast
                        ElseIf adoMate.BOF Then
                            adoMate.MoveFirst
                        End If
                        Call Show_Tab(adoMate)
                    End If
                End If
            End If
        Case "first"
            Call First
        Case "last"
            Call Last
        Case "prev"
            Call Prev
        Case "next"
            Call Sub_next
        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 First()         '首张

    If adoMate.State = 1 Then
        If adoMate.RecordCount > 0 Then
            adoMate.MoveFirst
            intNowRec = 1
            SzToolbar.Buttons("first").Enabled = False
            SzToolbar.Buttons("prev").Enabled = False
            SzToolbar.Buttons("next").Enabled = True
            SzToolbar.Buttons("last").Enabled = True
            Call Show_Tab(adoMate)
        End If
    End If
End Sub
Private Sub Last()          '末张
    If adoMate.State = 1 Then
        If adoMate.RecordCount > 0 Then
            adoMate.MoveLast
            intNowRec = conRecNum
            SzToolbar.Buttons("next").Enabled = False
            SzToolbar.Buttons("last").Enabled = False
            SzToolbar.Buttons("first").Enabled = True
            SzToolbar.Buttons("prev").Enabled = True
            Call Show_Tab(adoMate)
        End If
    End If
End Sub
Private Sub Prev()          '上张
    If adoMate.State = 1 Then
        SzToolbar.Buttons("next").Enabled = True
        SzToolbar.Buttons("last").Enabled = True
        If adoMate.RecordCount > 0 Then
            intNowRec = intNowRec - 1
            If adoMate.EOF Then
                adoMate.MovePrevious
            End If
            If Not adoMate.BOF Then
                adoMate.MovePrevious
                If Not adoMate.BOF Then
                    Call Show_Tab(adoMate)
                End If
            End If
            If adoMate.BOF Then
                SzToolbar.Buttons("first").Enabled = False
                SzToolbar.Buttons("prev").Enabled = False
            End If
            
        End If
    End If
End Sub
Private Sub Sub_next()          '下张
    If adoMate.State = 1 Then
        If adoMate.RecordCount > 0 Then
            SzToolbar.Buttons("first").Enabled = True
            SzToolbar.Buttons("prev").Enabled = True
            intNowRec = intNowRec + 1
            If adoMate.BOF Then
                adoMate.MoveNext
            End If
            If Not adoMate.EOF Then
                adoMate.MoveNext
                If Not adoMate.EOF Then
                    Call Show_Tab(adoMate)
                End If
            End If
            If adoMate.EOF Then
                SzToolbar.Buttons("next").Enabled = False
                SzToolbar.Buttons("last").Enabled = False
            End If
        End If
    End If

End Sub

Private Sub Sub_Query(Int_QueryType As Integer)                                     '生成查询结果(Define)
    
   Dim Sqlstr1 As String                        '查询字符串
   Dim Sqlstr2 As String
   Dim Sqlstr As String
   Dim Coljsq As Long                          '网格列计数器
   Dim jsqte As Integer                        '临时动态计数器
   Dim Xtyear As Integer
   Dim Period As Integer
   Dim adoPeriod As New ADODB.Recordset
   
 '以下为用户自定义部分[

 With KF_FrmMateAccCxtj
     
     '显示查询会计期间

     Sqlstr1 = "select mnumber,(select mname from gy_material where kf_v_mledger.mnumber=gy_material.mnumber) as mname, " & _
               " (select model from gy_material where kf_v_mledger.mnumber=gy_material.mnumber) as model, " & _
               " (select primaryunitname from gy_material where kf_v_mledger.mnumber=gy_material.mnumber) as primaryunitname, " & _
               " (select invsortname from KF_V_InvSort where kf_v_mledger.mnumber=KF_V_InvSort.mnumber) as invsortname" & _
               " from kf_v_mledger where 1=1 "
     Sqlstr2 = "select  mnumber, (select mname from gy_material where kf_v_mateinout.mnumber=gy_material.mnumber) as mname, " & _
               " (select model from gy_material where kf_v_mateinout.mnumber=gy_material.mnumber) as model, " & _
               " (select primaryunitname from gy_material where kf_v_mateinout.mnumber=gy_material.mnumber) as primaryunitname,  " & _
               " (select invsortname from KF_V_InvSort where kf_v_mateinout.mnumber=KF_V_InvSort.mnumber) as invsortname" & _
               " from kf_v_mateinout where billcode not in('1201','1202','1203') "
     
     Xtyear = Val(Mid(Trim(.Combo_Kjqj2.Text), 1, 4))
     Period = Val(Mid(Trim(.Combo_Kjqj2.Text), 6))
     Str_QueryCondi = ""
     Set adoPeriod = Cw_DataEnvi.DataConnect.Execute("select period from gy_kjrlb where beginflag=1 and kjyear=" & Xtyear)
     
     For jsqte = 1 To 5
        Select Case jsqte
          
           Case 1  '会计期间
            If Trim(.Combo_Kjqj2.Text) <> "" Then
                If Not adoPeriod.EOF Then
                    If Val(Mid(Trim(.Combo_Kjqj1.Text), 6)) < Val(adoPeriod.Fields("period")) Then
                        Sqlstr1 = Sqlstr1 & " and kjyear=" & Xtyear & " and Period between " & Val(adoPeriod.Fields("period")) & " and " & Period
                        Sqlstr2 = Sqlstr2 & " and kjyear=" & Xtyear & " and Period between " & Val(adoPeriod.Fields("period")) & " and " & Period
                        Str_QueryCondi = Str_QueryCondi & "  kjyear=" & Xtyear & " and Period between " & Val(adoPeriod.Fields("period")) & " and " & Period
                    Else
                        Sqlstr1 = Sqlstr1 & " and kjyear=" & Xtyear & " and Period between " & Val(Mid(Trim(.Combo_Kjqj1.Text), 6)) & " and " & Period
                        Sqlstr2 = Sqlstr2 & " and kjyear=" & Xtyear & " and Period between " & Val(Mid(Trim(.Combo_Kjqj1.Text), 6)) & " and " & Period
                        Str_QueryCondi = Str_QueryCondi & "  kjyear=" & Xtyear & " and Period between " & Val(Mid(Trim(.Combo_Kjqj1.Text), 6)) & " and " & Period
                    End If
                Else
                    Sqlstr1 = Sqlstr1 & " and kjyear=" & Xtyear & " and Period between " & Val(Mid(Trim(.Combo_Kjqj1.Text), 6)) & " and " & Period
                    Sqlstr2 = Sqlstr2 & " and kjyear=" & Xtyear & " and Period between " & Val(Mid(Trim(.Combo_Kjqj1.Text), 6)) & " and " & Period
                    Str_QueryCondi = Str_QueryCondi & "  kjyear=" & Xtyear & " and Period between " & Val(Mid(Trim(.Combo_Kjqj1.Text), 6)) & " and " & Period
                End If
            End If
            
          Case 2   '仓库
             If Trim(.LrText(0).Text) <> "" Then
                Str_WH = Trim(.LrText(0).Tag)
                Sqlstr1 = Sqlstr1 & " and whcode='" & Str_WH & "'"
                Sqlstr2 = Sqlstr2 & " and whcode='" & Str_WH & "'"
                Str_QueryCondi = Str_QueryCondi & " and whcode='" & Str_WH & "'"
             Else
                Str_WH = ""
             End If
         
          Case 3   '物料分类
            If Trim(.LrText(2).Text) <> "" Then
             Dim StrTemp As String
                StrTemp = "SELECT mnumber From gy_material WHERE invsortcode LIKE '" & Trim(.LrText(2).Tag) & "%'"
                Sqlstr1 = Sqlstr1 & " and mnumber in(" & StrTemp & ")"
                Sqlstr2 = Sqlstr2 & " and mnumber in(" & StrTemp & ")"
                Str_QueryCondi = Str_QueryCondi & " and invsortcode like '" & Str_WH & "%'"
            End If
            
          Case 4   '材料
            If Trim(.LrText(3).Text) <> "" Then
                Sqlstr1 = Sqlstr1 & " and mnumber='" & Trim(.LrText(3).Text) & "'"
                Sqlstr2 = Sqlstr2 & " and mnumber='" & Trim(.LrText(3).Text) & "'"
            End If
             
          Case 5   '货区
            If Trim(.LrText(1).Text) <> "" Then
                Sqlstr1 = Sqlstr1 & " and marea='" & Trim(.LrText(1).Tag) & "'"
                Sqlstr2 = Sqlstr2 & " and marea='" & Trim(.LrText(1).Tag) & "'"
                Str_QueryCondi = Str_QueryCondi & " and marea='" & Trim(.LrText(1).Tag) & "'"
            End If
        End Select
    Next jsqte
 End With
 Sqlstr = Sqlstr1 & " union " & Sqlstr2 & " order by mnumber"
Set adoMate = Cw_DataEnvi.DataConnect.Execute(Sqlstr)

If Not adoMate.EOF Then
 adoMate.MoveFirst
 Call Show_Tab(adoMate)
Else
 Label1 = "物料分类:   "
 Label2 = "物料编码:   " & KF_FrmMateAccCxtj.LrText(3).Text
 Label3 = "物料名称:   " & KF_FrmMateAccCxtj.Label2.Caption
 Label4 = "规格型号:   "
 Label5 = "计量单位:   "

 CxbbGrid.Clear 1
 CxbbGrid.Rows = CxbbGrid.FixedRows
End If
End Sub