VB开发的ERP系统

    With Pic_Title
        .Width = Me.Width - 160
    End With
    
    GsToolbar.Left = Me.Width - GsToolbar.Width - 140
End Sub

Private Sub Form_Load()                                                   '窗体装入
    
    '调入打印页面设置窗体
    
    XtReportCode = "Cwzz_jzpzcx"
    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 = "Cwzz_jzpzcx"
    Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Sfxshjwg = GridInf(7)
    Szzls = CxbbGrid.Cols - 1
    
    '调整标题位置
    SetTitlePos tsLabel(4)
    
    '编辑(新增、修改、删除)权限索引
    Str_RightEdit = "Cwzz_jzpzcx_edit"
    Str_RightCheck = "Cwzz_jzpzcx_check"
    
End Sub

Private Sub Form_Unload(Cancel As Integer)                                  '窗体卸载
    '卸载条件窗体
    PZ_FrmPzcxtj.UnloadCheck.Value = 1
    Unload PZ_FrmPzcxtj
    '卸载打印页面设置窗体
    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"                                            '查 询
        PZ_FrmPzcxtj.Show 1
    Case "pz"                                            '凭 证
        Call CxbbGrid_DblClick
    Case "xz"                                            '新 增
        Call Sub_AddBill
    Case "sc"                                            '删除当前单据
        Call Sub_DeleteBill
    Case "sh"                                            '审 核
        Call Sub_CheckBill
    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

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 Int_VouchID%                            '记录上一张凭证标识
    Dim Dbl_Jfhj#, Dbl_Dfhj#                    '每张凭证借贷方合计
    
    '以下为用户自定义部分[
    
    With PZ_FrmPzcxtj
        
        '显示查询会计期间
        Lab_TitleText.Caption = .Combo_Kjqj(0).Text & "-" & .Combo_Kjqj(1).Text
        
        Str_QueryCondi = " where 1=1 "
        For Jsqte = 1 To 28
            Select Case Jsqte
                
            Case 1   '凭证范围
                Select Case Trim(.Combo_Pzfw.Text)
                Case "未记帐凭证"
                    Str_QueryCondi = Str_QueryCondi & " and b.BookFlag=0"
                Case "记帐凭证"
                    Str_QueryCondi = Str_QueryCondi & " and b.BookFlag=1"
                End Select
                
            Case 2   '凭证类别
                If GetComboKey(.Imgebo_VouchClass, 0) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.VouchClassCode='" & Trim(GetComboKey(.Imgebo_VouchClass, 0)) & "'"
                End If
                
            Case 3   '会计期间
                If .Combo_Kjqj(0).Text <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.Year='" & Xtyear & "' and b.Period>='" & Mid(Trim(.Combo_Kjqj(0).Text), 6, 2) & "' and b.Period<='" & Mid(Trim(.Combo_Kjqj(1).Text), 6, 2) & "'"
                End If
            Case 4   '凭证号范围(起始)
                Str_QueryCondi = Str_QueryCondi & " and b.VouchNo>= " & Val(.LrText(0).Text)
                
            Case 5   '凭证号范围(终止)
                If Val(.LrText(1)) <> 0 Then
                    Str_QueryCondi = Str_QueryCondi & " and b.VouchNo<= " & Val(.LrText(1).Text)
                End If
                
            Case 6   '科目号
                If Trim(.LrText(2)) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.Ccode like '" & Trim(.LrText(2).Text) & "%'"
                End If
                
            Case 7   '制单人
                If Trim(.Imgebo_Bill.Text) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.Bill='" & Trim(.Imgebo_Bill.Text) & "'"
                End If
                
            Case 8   '审核人
                If Trim(.Imgebo_Checker.Text) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.Checker='" & Trim(.Imgebo_Checker.Text) & "'"
                End If
                
            Case 9   '记帐人
                If Trim(.Imgebo_Book.Text) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.Book='" & Trim(.Imgebo_Book.Text) & "'"
                End If
                
            Case 10   '摘要
                If Trim(.LrText(3).Text) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.Digest Like '" & Trim(.LrText(3).Text) & "%'"
                End If
                
            Case 11   '金额范围(起始)
                Str_QueryCondi = Str_QueryCondi & " and (b.Jfje+b.Dfje>=" & Val(.LrText(4).Text) & " OR b.Dfje>=" & Val(.LrText(4).Text) & ")"
                
            Case 12   '金额范围(终止)
                If Val(.LrText(5)) > 0 Then
                    Str_QueryCondi = Str_QueryCondi & " and (b.Jfje+b.Dfje<=" & Val(.LrText(5).Text) & " and b.Dfje<=" & Val(.LrText(5).Text) & ")"
                End If
                
            Case 13   '数量范围(起始)
                If Val(.LrText(6).Text) > 0 Then
                    Str_QueryCondi = Str_QueryCondi & " and (b.Jfsl>=" & Val(.LrText(6).Text) & " OR b.Dfsl>=" & Val(.LrText(6).Text) & ")"
                End If
                
            Case 14   '数量范围(终止)
                If Val(.LrText(7)) > 0 Then
                    Str_QueryCondi = Str_QueryCondi & " and (b.Jfsl<=" & Val(.LrText(7).Text) & " and b.Dfsl<=" & Val(.LrText(7).Text) & ")"
                End If
                
            Case 15   '外币范围(起始)
                If Val(.LrText(8).Text) > 0 Then
                    Str_QueryCondi = Str_QueryCondi & " and (b.WbJfje>=" & Val(.LrText(8).Text) & " OR b.WbDfje>=" & Val(.LrText(8).Text) & ")"
                End If
            Case 16   '外币范围(终止)
                If Val(.LrText(9)) > 0 Then
                    Str_QueryCondi = Str_QueryCondi & " and (b.WbJfje<=" & Val(.LrText(9).Text) & " and b.WbDfje<=" & Val(.LrText(9).Text) & ")"
                End If
                
            Case 17   '外币名称
                If GetComboKey(.Imgebo_ForeignCurr, 0) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.ForeignCurrCode='" & Trim(GetComboKey(.Imgebo_ForeignCurr, 0)) & "'"
                End If
                
            Case 18   '个人
                If Trim(.LrText(11).Tag) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.PersonCode = '" & Trim(.LrText(11).Tag) & "'"
                End If
                
            Case 19  '部门
                If Trim(.LrText(10).Tag) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.DeptCode = '" & Trim(.LrText(10).Tag) & "'"
                End If
                
            Case 20  '往来客户
                If Trim(.LrText(12).Tag) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.CusCode = '" & Trim(.LrText(12).Tag) & "'"
                End If
                
            Case 21   '项目类别
                If GetComboKey(.Imgebo_ItemClass, 0) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.ItemClassCode='" & Trim(GetComboKey(.Imgebo_ItemClass, 0)) & "'"
                End If
                
            Case 22  '核算项目
                If Trim(.LrText(13).Tag) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.ItemCode= '" & Trim(.LrText(13).Tag) & "'"
                End If
                
            Case 23   '结算方式
                If GetComboKey(.Imgebo_Settlement, 0) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.SScode='" & Trim(GetComboKey(.Imgebo_Settlement, 0)) & "'"
                End If
                
            Case 24  '票号
                If Trim(.LrText(14).Text) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.BillNo= '" & Trim(.LrText(14).Text) & "'"
                End If
                
            Case 25  '有错凭证
                
                If .Chk_ErrorBill.Value = 1 Then
                    Str_QueryCondi = Str_QueryCondi & " and b.ErrorFlag= 1"
                End If
                
            Case 26  '审核状态
                If .Opt_Check(1).Value Then
                    Str_QueryCondi = Str_QueryCondi & " and b.CheckFlag= 0"
                End If
                If .Opt_Check(2).Value Then
                    Str_QueryCondi = Str_QueryCondi & " and b.CheckFlag= 1"
                End If
                
            Case 27  '往来供应商
                If Trim(.LrText(15).Tag) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.SupplierCode = '" & Trim(.LrText(15).Tag) & "'"
                End If
                
            Case 28  '凭证来源
                If Trim(.Combo_VouchSource.Text) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and b.VouchSource = '" & Trim(.Combo_VouchSource.Text) & "'"
                 End If
                
            End Select
        Next Jsqte
    End With
    Sqlstr = "SELECT a.*,Cwzz_AccCode.Cname From Cwzz_V_AccVouch a LEFT OUTER JOIN " & _
    " Cwzz_AccCode ON " & _
    " a.Ccode = Cwzz_AccCode.Ccode" & _
    " Where EXISTS (SELECT * From Cwzz_V_AccVouch b " & Str_QueryCondi & " AND a.VouchID=b.VouchID) " & _
    " Order by Year,Period,VouchClassCode,VouchNo,Vouchid"
    
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With Rec_Query
        CxbbGrid.Rows = CxbbGrid.FixedRows
        CxbbGrid.Rows = CxbbGrid.FixedRows + .RecordCount
        Jsqte = CxbbGrid.FixedRows
        
        Do While Not .EOF
            If Jsqte >= CxbbGrid.Rows Then
                CxbbGrid.AddItem ""
            End If
            
            CxbbGrid.TextMatrix(Jsqte, 0) = .Fields("VouchID")           '凭证ID
            
            '如果为同一张凭证则不再输出制单日期和凭证号
            If Int_VouchID <> .Fields("VouchID") Then
                Int_VouchID = .Fields("VouchID")                          '凭证ID
                CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = .Fields("Ddate")              '制单日期
                CxbbGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("VouchClassCode") & "") + "-" + Mid(Trim(Str(10000 + .Fields("VouchNo"))), 2, 4) '凭证号
                
                '如果凭证输出合计,则不加此分割色
                If PZ_FrmPzcxtj.Chk_Sum.Value = 0 Then
                    '分割颜色
                    CxbbGrid.Cell(flexcpBackColor, Jsqte, 0, , CxbbGrid.Cols - 1) = Lab_Color(0).BackColor
                End If
                
            End If
            
            CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("Digest") & "")           '摘要