📄 -i+

📁 VB开发的ERP系统
💻
📖 第 1 页 / 共 4 页
字号:
上一页 1 2 34
            CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = .Fields("Billdate")                    '单据日期
            CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("BillItemName") & "")     '单据类型
            CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("BillCode") & "")         '单据编号
            CxbbGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("CusName") & "")          '客户
            CxbbGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("ForeignCurrName") & "")  '币别
            If .Fields("YbSsje") <> 0 Then                                                                     '原币金额
               CxbbGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = .Fields("YbSsje")
            End If
            CxbbGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = .Fields("AccRate")                     '记帐汇率
            If .Fields("BbSsje") <> 0 Then                                                                     '本币金额
               CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = .Fields("BbSsje")
            End If
            CxbbGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("DeptName") & "")         '部门
            CxbbGrid.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("PersonName") & "")       '业务员
            CxbbGrid.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("Maker") & "")            '制单人
            CxbbGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = Trim(.Fields("Checker") & "")          '审核人
            If Not IsNull(.Fields("VouchClassCode")) Then
               CxbbGrid.TextMatrix(jsqte, Sydz("013", GridStr(), Szzls)) = Trim(.Fields("VouchClassCode") & "") + Mid(Trim(Str(10000 + Val(.Fields("VouchNo") & ""))), 2, 4)
            End If
            CxbbGrid.TextMatrix(jsqte, Sydz("014", GridStr(), Szzls)) = Trim(.Fields("Digest") & "")          '摘要
            
            '退款单变色显示
            If .Fields("BillItemCode") = "32" Then
               CxbbGrid.Cell(flexcpForeColor, jsqte, 0, , CxbbGrid.Cols - 1) = Lab_Color(0).BackColor
            End If
            
            Dbl_WbHjje = Dbl_WbHjje + .Fields("YbSsje")
            Dbl_BbHjje = Dbl_BbHjje + .Fields("BbSsje")
            
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(jsqte) = Sjhgd
            
            '动态集指针加1,同时将计数器加1(Fixed)
            .MoveNext
            jsqte = jsqte + 1
            
        Loop
        
        '添加合计行
        If Dbl_WbHjje <> 0 Or Dbl_BbHjje <> 0 Then
           CxbbGrid.AddItem ""
           CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("002", GridStr(), Szzls)) = "  合  计"
           If Dbl_WbHjje <> 0 Then
                CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("006", GridStr(), Szzls)) = Dbl_WbHjje
           End If
           If Dbl_BbHjje <> 0 Then
                CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("008", GridStr(), Szzls)) = Dbl_BbHjje
           End If
           CxbbGrid.Cell(flexcpBackColor, CxbbGrid.Rows - 1, 0, CxbbGrid.Rows - 1, CxbbGrid.Cols - 1) = &HFFFF00
        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
    
    Sqlstr = "SELECT CloseBillID From RP_CloseBill Where CloseBillID=" & 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
            '调入单据处理窗体
            With SK_FrmJsdcl
                
                '填充查询单据标识
                XT_BillID = CxbbGrid.TextMatrix(CxbbGrid.Row, 0)
                Xtcdcsfz = Str_QueryCondi
                
                '设置单据处理为列表查询(修改)状态
                Xtcdcs = "2"
                .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 If
    End With
    
End Sub

Private Sub Sub_AddBill()                                              '新增单据
    
    With SK_FrmJsdcl
        
        '设置单据处理为填制单据状态
        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_DeleteBill()                                            '删除选中当前单据
    
    Dim YAnswer As Integer
    Dim Lng_BillID As Long           '单据标识
       
    '记录行总数与固定行数相等则退出
    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
    
    Tsxx = "请确认是否删除当前结算单?"
    yhAnswer = Xtxxts(Tsxx, 2, 2)
    
    If yhAnswer = 1 Then
        
        '1.判断当前单据是否允许删除
        If Not Fun_AllowDelete Then
            Exit Sub
        End If
        
        '2.删除单据所有内容
        Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
        
        On Error GoTo Swcwcl
        
        Cw_DataEnvi.DataConnect.BeginTrans
        Cw_DataEnvi.DataConnect.Execute ("Delete RP_CloseBill Where CloseBillID=" & Lng_BillID)        '删除单据内容
        Cw_DataEnvi.DataConnect.CommitTrans
        
        '重新汇总合计金额
        Dbl_WbHjje = Dbl_WbHjje - CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("006", GridStr(), Szzls))
        Dbl_BbHjje = Dbl_BbHjje - CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("008", GridStr(), Szzls))
        
        '删除网格中单据数据
        CxbbGrid.RemoveItem (CxbbGrid.Row)
        
        '刷新合计行
        If Dbl_WbHjje <> 0 Or Dbl_BbHjje <> 0 Then
            CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("002", GridStr(), Szzls)) = "  合  计"
            If Dbl_WbHjje <> 0 Then
                CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("006", GridStr(), Szzls)) = Dbl_WbHjje
            End If
            If Dbl_BbHjje <> 0 Then
                CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("008", GridStr(), Szzls)) = Dbl_BbHjje
            End If
            CxbbGrid.Cell(flexcpBackColor, CxbbGrid.Rows - 1, 0, CxbbGrid.Rows - 1, CxbbGrid.Cols - 1) = &HFFFF00
        Else
            CxbbGrid.RemoveItem (CxbbGrid.Rows - 1)
        End If
        
    Else
        Exit Sub
    End If
    
    Exit Sub
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "删除单据过程中出现未知错误,程序自动恢复删除前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
    
End Sub

Private Function Fun_AllowDelete() As Boolean                                        '判断当前单据是否允许删除
    
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '查询字符串
    Dim Lng_BillID As Long                 '单据ID
    
    Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
    Sqlstr = "Select Checker From RP_CloseBill Where CloseBillID=" & Lng_BillID
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If Not .EOF Then
            If Trim(.Fields("Checker") & "") <> "" Then
                Tsxx = "该结算单已审核确认,不能删除!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
        End If
    End With
    Fun_AllowDelete = True
    
End Function

Private Sub Sub_CheckBill()                            '审核单据
  Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  Dim Lng_BillID As Long           '单据标识
  
  '非数据行退出
  If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
     Exit Sub
  End If
  
  Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
  
  If Fun_CheckCloseBill(Lng_BillID) Then
    
        '写入审核人(系统操作员)
        CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("012", GridStr(), Szzls)) = Xtczy           '审核人
        
        Tsxx = "单据审核完毕!"
        Call Xtxxts(Tsxx, 0, 4)
  End If
 
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
上一页 1 2 34
⌨️ 快捷键说明

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