⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄

📁 VB开发的ERP系统
💻
📖 第 1 页 / 共 5 页
字号:
                    End If
                    If .Fields("SumQuan") <> 0 Then                                                                            '实际金额
                        CxbbGrid.TextMatrix(Jsqte, Sydz("017", GridStr(), Szzls)) = .Fields("SumEMoney") / .Fields("SumQuan")
                    End If
                    If .Fields("SumEmoney") <> 0 Then                                                                          '实际金额
                        CxbbGrid.TextMatrix(Jsqte, Sydz("018", GridStr(), Szzls)) = .Fields("SumEMoney")
                    End If
                
                Else
                    Jsqte = FindRow
                    If .Fields("SumQuan") <> 0 Then                                                                            '数量
                        CxbbGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls)) = Val(CxbbGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls))) + .Fields("SumQuan")
                    End If
                    If .Fields("SumQuan") <> 0 Then                                                                            '计划单价
                        CxbbGrid.TextMatrix(Jsqte, Sydz("015", GridStr(), Szzls)) = .Fields("SumPlanMoney") / .Fields("SumQuan")
                    End If
                    If .Fields("SumPlanMoney") <> 0 Then                                                                       '计划金额
                        CxbbGrid.TextMatrix(Jsqte, Sydz("016", GridStr(), Szzls)) = Val(CxbbGrid.TextMatrix(Jsqte, Sydz("016", GridStr(), Szzls))) + .Fields("SumPlanMoney")
                    End If
                    If .Fields("SumQuan") <> 0 Then                                                                            '实际金额
                        CxbbGrid.TextMatrix(Jsqte, Sydz("017", GridStr(), Szzls)) = .Fields("SumEMoney") / .Fields("SumQuan")
                    End If
                    If .Fields("SumEmoney") <> 0 Then                                                                          '实际金额
                        CxbbGrid.TextMatrix(Jsqte, Sydz("018", GridStr(), Szzls)) = Val(CxbbGrid.TextMatrix(Jsqte, Sydz("018", GridStr(), Szzls))) + .Fields("SumEMoney")
                    End If
                End If
                
                '<<]
                '设置数据行高度(Fixed)
                CxbbGrid.RowHeight(Jsqte) = Sjhgd
                
                '动态集指针加1,同时将计数器加1(Fixed)
                .MoveNext
            Loop
        End With
    End If
    
    
    '输入合计
    With CxbbGrid
        If Not .Rows = .FixedRows Then
           .SubtotalPosition = flexSTBelow
           For Jsqte = Qslz To .Cols - 1
                If GridBoolean(Jsqte, 4) Then
                     .Subtotal flexSTSum, 0, Jsqte, , &HF7F3EC, , , , , True
                End If
           Next
           .RowHeight(.Rows - 1) = Sjhgd
           .TextMatrix(.Rows - 1, Sydz("002", GridStr(), Szzls)) = " 合计 "
        End If
    End With
    
    ']以上为用户自定义部分

End Sub

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

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

    If Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 1)) = "1308" Then
        SqlStr = "SELECT StartInputMainId From Chhs_StartInputMain Where StartInputMainId=" & 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 = "3"
                 
                 '调入单据处理窗体
                Start_BillInput.Show 1
            End If
        End With
    Else
                '期初暂估单
        SqlStr = "SELECT InoutMainId From Gy_InoutMain Where InoutMainId=" & 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 = "3"
                
                '调入单据处理窗体
                If Start_BillChalkitupCond.Opt_Wjz Then
                    Xtcdcsfz = "1211"
                    Eval_StockInBill.Show 1
                Else
                    Xtcdcsfz = " startflag=1 and kjyear=" & PGKjYear & " and period =" & StartMon
                    Eval_BlueBill.Show 1
                End If
            End If
        End With
    End If

End Sub

Private Sub Sub_Mx()                                             '明细
    
    '生成查询结果
    CxbbGrid.Redraw = False
    Call Sub_Query(0)
    CxbbGrid.Redraw = True
    
    '调整工具条
    With SzToolbar
        If CxbbGrid.Rows = CxbbGrid.FixedRows Then
            .Buttons("Bill").Enabled = False
            .Buttons("mx").Enabled = False
            .Buttons("hz").Enabled = False
            .Buttons("jz").Enabled = False
            .Buttons("hf").Enabled = False
        Else
            .Buttons("cx").Enabled = True
            .Buttons("Bill").Enabled = True
            .Buttons("hz").Enabled = True
            .Buttons("mx").Enabled = False
            If Start_BillChalkitupCond.Opt_Wjz Then
                .Buttons("jz").Enabled = True
                .Buttons("hf").Enabled = False
            Else
                .Buttons("jz").Enabled = False
                .Buttons("hf").Enabled = True
            End If
       End If
    End With
   
    If GsToolbar.Enabled = False Then
        
        '显示汇总后隐藏的网格列
        For Jsqte = Qslz To CxbbGrid.Cols - 1
            CxbbGrid.ColHidden(Jsqte) = GridColHide(Jsqte)
        Next
    End If
    
    GsToolbar.Enabled = True
    
End Sub

Private Sub Sub_Hz()                                            '汇总
    
    If CxbbGrid.Rows = CxbbGrid.FixedRows Then Exit Sub
    
    '生成查询结果
    CxbbGrid.Redraw = False
    Call Sub_QueryHz(0)
    CxbbGrid.Redraw = True
    
    With SzToolbar
        .Buttons("cx").Enabled = False
        .Buttons("Bill").Enabled = False
        .Buttons("jz").Enabled = False
        .Buttons("hf").Enabled = False
        .Buttons("hz").Enabled = False
        .Buttons("mx").Enabled = True
    End With
    
    GsToolbar.Enabled = False
    
    For Jsqte = Qslz To CxbbGrid.Cols - 1
        GridColHide(Jsqte) = CxbbGrid.ColHidden(Jsqte)
    Next
       
End Sub

Private Sub Sub_Qcjz()               '期初记帐
Dim Rectemp As Recordset
Dim RecTempFz As New ADODB.Recordset
Dim RectempMx As New ADODB.Recordset
Dim RecTempZz As New ADODB.Recordset

    If CxbbGrid.Rows = CxbbGrid.FixedRows Then Exit Sub
    
    
    '日常单据已记帐期初单据不能记帐
    SqlStr = "select distinct chalkitupman from chhs_list a " & _
            Trim(Str_QueryCondi) & " and startflag=0 "
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If Not Rectemp.EOF Then
        Tsxx = "日常单据已记帐,期初单据不能记帐!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    On Error GoTo Cwcl
    
    Xt_Wait.Show
    Xt_Wait.Refresh
    
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '打开明细帐
    If RectempMx.State = 1 Then RectempMx.Close
    RectempMx.Open "select * from Chhs_List", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
    
    '期初单据
    SqlStr = "SELECT * FROM Chhs_V_StartBill a " & _
             Trim(Str_QueryCondi) & " Order By a.Whcode,a.StartInputMainId,a.StartInputSubId"
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    Do While Not Rectemp.EOF
                
        '入库金额为零,不允许记帐
        If Rectemp.Fields("emoney") <> 0 Then
            With RectempMx
                .AddNew
                .Fields("inoutflag") = 1
                .Fields("billnum") = Trim(Rectemp.Fields("billnum"))
                .Fields("inoutmainid") = Rectemp.Fields("startinputmainid") + 0
                .Fields("inoutsubid") = Rectemp.Fields("startinputsubid") + 0
                If Trim(Rectemp.Fields("billdate") & "") <> "" Then
                    .Fields("billdate") = CDate(Rectemp.Fields("billdate"))
                End If
                .Fields("chalkdate") = Xtrq
                .Fields("kjyear") = Xtyear
                .Fields("period") = StartMon
                .Fields("billcode") = Trim(Rectemp.Fields("billcode"))
                .Fields("whcode") = Trim(Rectemp.Fields("whcode"))
                .Fields("mnumber") = Trim(Rectemp.Fields("mnumber"))
                .Fields("maker") = Trim(Rectemp.Fields("maker"))
                .Fields("checker") = Trim(Rectemp.Fields("checker"))
                .Fields("chalkitupman") = Xtczy
                .Fields("startflag") = 1
                .Fields("remark") = Trim(Rectemp.Fields("remark") & "")
                If Not IsNull(Trim(Rectemp.Fields("deptcode"))) Then
                    .Fields("deptcode") = Trim(Rectemp.Fields("deptcode"))
                End If
                If Not IsNull(Trim(Rectemp.Fields("suppliercode"))) Then
                    .Fields("suppliercode") = Trim(Rectemp.Fields("suppliercode"))
                End If
                If Not IsNull(Trim(Rectemp.Fields("inoutclasscode"))) Then
                    .Fields("inoutclasscode") = Trim(Rectemp.Fields("inoutclasscode"))
                End If
                If Not IsNull(Trim(Rectemp.Fields("personcode"))) Then
                    .Fields("personcode") = Trim(Rectemp.Fields("personcode"))
                End If
                
                '存货科目
                Xtfhcs = ""
                Xtfhcsfz = ""
                Call MaccCode(Trim(Rectemp.Fields("whcode")), Trim(Rectemp.Fields("mnumber")), Trim(Rectemp.Fields("invsortcode")))
                .Fields("mateacct") = Xtfhcs
                If Qmclcy And Trim(Rectemp.Fields("pricemode")) = "计划价法" Then
                    .Fields("diffacct") = Xtfhcsfz
                End If
                
                '对方科目
                Xtfhcs = ""
                Call DfaccCode(Trim(Rectemp.Fields("inoutclasscode") & ""), Trim(Rectemp.Fields("deptcode") & ""), Trim(Rectemp.Fields("invsortcode")), Trim(Rectemp.Fields("mnumber")))
                .Fields("dfacct") = Xtfhcs
                
                .F

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -