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

📄 --+

📁 VB开发的ERP系统
💻
📖 第 1 页 / 共 5 页
字号:
            Exit Sub
        End If
    End If
    '卸载打印页面窗体
    Unload Dyymctbl
 
    '判断单据是否发生变化,并返回相应标识
    If Bln_BillChange Then
        Xtfhcs = "1"
    Else
        Xtfhcs = "0"
    End If
   
End Sub

Private Sub Sjcsh(Str_Pzclzt As String)              '数据初始化模块(根据实际情况)
    
    Dim Sqlstr As String       '查询单据列表条件

    '[>>根据实际情况初始化
    Select Case Str_Pzclzt
        Case "1"   '填制单据
            '调入用户查询结果动态集
            Sqlstr = "SELECT ConsignBillMainID From Xs_ConsignBillMain Where ConsignDate='" & Xtrq & "' and billtype=1 ORDER BY ConsignBillMainID"
            Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
      
            '新增单据
            Call Sub_AddBill
        Case "2"   '查询单据(单据列表)
            Lab_BillId.Caption = XT_BillID
            Str_QueryCondi = Xtcdcsfz
            Call Sub_ShowBill
            Call Sub_OperStatus("10")
      
            '调入用户查询结果动态集
            Sqlstr = "SELECT DISTINCT ConsignBillMainID From Xs_V_ConsignBill " & Str_QueryCondi & " ORDER BY ConsignBillMainID"
            Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            Rec_Query.Find "ConsignBillMainID=" & Val(Lab_BillId.Caption)
        Case "3"   '明细帐联查单据
            '设置工具条显示
            Lab_BillId.Caption = XT_BillID
            With Tlb_Action
                .Buttons("xz").Enabled = False             '新增
                .Buttons("xg").Enabled = False             '修改
                .Buttons("sc").Enabled = False             '删除
                .Buttons("fgh0").Enabled = False           '分隔行
                .Buttons("zh").Enabled = False             '增行
                .Buttons("sh").Enabled = False             '删行
                .Buttons("fgh1").Enabled = False           '分隔行
                .Buttons("bc").Enabled = False             '保存
                .Buttons("fq").Enabled = False             '放弃
                .Buttons("shsh").Enabled = False           '审核
                .Buttons("shqs").Enabled = False           '弃审
                .Buttons("fgh2").Enabled = False           '分隔行
                .Buttons("first").Enabled = False          '首张
                .Buttons("prev").Enabled = False           '上张
                .Buttons("next").Enabled = False           '下张
                .Buttons("last").Enabled = False           '末张
                .Buttons("fgh5").Enabled = False           '分割行
            End With
      
            Call Sub_ShowBill
      
            '设置操作状态为浏览
            Lab_OperStatus.Caption = "1"
      
            '录入文本框
            For Jsqte = Max_Text_Index To 0 Step -1
            LrText(Jsqte).Enabled = False
        Next Jsqte
    End Select
  
    '<<]
  
End Sub

Private Sub Sub_ShowBill()                                          '根据当前单据ID显示整张单据内容
   
    '过程默认参数为当前窗体中单据ID:Lab_BillID
    Dim Sqlstr As String                           '临时使用字符串
    Dim RecTemp As New ADODB.Recordset             '临时使用动态集
    Dim RsTemp As New ADODB.Recordset
    Dim Jsqte As Long                              '临时计数器

    '禁止网格刷新动作,为加快网格显示速度(Fixed)
    WglrGrid.Redraw = False

    '本张单据查询字符串
    Sqlstr = "SELECT * from Xs_V_ConsignBill where ConsignBillMainID='" & Lab_BillId.Caption & "' order by consignbillmainid,consignbillsubid"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
      
    With RecTemp
        WglrGrid.Rows = WglrGrid.FixedRows
        If .EOF Then
            WglrGrid.Redraw = True
            Exit Sub
        Else
            '[>>显示单据头
            TextChangeLock = True     '文本框加锁
            If Trim(.Fields("ConsignFlag")) Then         '销售方式
                Option2.Value = True
            Else
                Option1.Value = True
            End If
            LrText(0).Text = Format(.Fields("ConsignDate"), "yyyy-mm-dd")   '退货日期
            LrText(1).Text = Trim(.Fields("ConsignCode") & "")              '退货单号
            LrText(2).Tag = Val(.Fields("returnsource") & "")               '源发货单ID
            LrText(2).Text = Trim(.Fields("returnsourceCode") & "")         '源发货单号
            LrText(3).Tag = Trim(.Fields("SellTypeCode") & "")              '销售类型
            LrText(3).Text = Trim(.Fields("SellTypename") & "")
            LrText(4).Tag = Trim(.Fields("cusCode") & "")                   '客户编码
            LrText(4).Text = Trim(.Fields("cusname") & "")
            LrText(5).Tag = Trim(.Fields("deptCode") & "")                  '部门编码
            LrText(5).Text = Trim(.Fields("deptname") & "")
            LrText(6).Tag = Trim(.Fields("personCode") & "")                '销售员
            LrText(6).Text = Trim(.Fields("personname") & "")
            LrText(7).Tag = Trim(.Fields("foreigncurrcode") & "")           '币种
            LrText(7).Text = Trim(.Fields("foreigncurrname") & "")
            LrText(8).Text = Trim(.Fields("exchrate") & "")                 '汇率
            LrText(8).Tag = Trim(.Fields("ConVertFlag") & "")
            LrText(9).Text = Trim(.Fields("fetchperson") & "")              '退货人
            LrText(10).Tag = Trim(.Fields("WhCode") & "")                   '仓库
            LrText(10).Text = Trim(.Fields("Whname") & "")
            LrText(11).Text = Trim(.Fields("remark") & "")                  '备注
            LrText(12).Text = Trim(.Fields("maker") & "")                   '制单人
            LrText(13).Text = Trim(.Fields("checker") & "")                 '审核人
            
            TextChangeLock = False    '文本框解锁
            '<<]
        End If
        Jsqte = WglrGrid.FixedRows
        Do While Not .EOF
            WglrGrid.AddItem ""
            '[>>显示单据分录
            WglrGrid.TextMatrix(Jsqte, 0) = "*"                                                                             '数据有效行标识(必填)
'            WglrGrid.TextMatrix(jsqte, 1) = .Fields("consultcost")       '参考成本
            WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("warecode") & "")      '货物编码
            WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("MName") & "")         '货物名称
            WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("Model") & "")         '规格型号
            WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("saleUnitName"))       '单位
            Sqlstr = "SELECT Recquantity from Xs_ConsignBillsub where ConsignBillMainID='" & LrText(2).Tag & "' and  warecode='" & Trim(.Fields("warecode")) & "'"
            Set RsTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If RsTemp.RecordCount > 0 Then
                WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(RsTemp.Fields("Recquantity") & "")      '实收数量
            End If
            WglrGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Abs(.Fields("Recquantity") & "")    '退货数量
            WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Val(.Fields("taxUnitPrice") & "")   '含税单价
            WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Abs(.Fields("taxMoney") & "")       '税额
            WglrGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Abs(.Fields("wholeMoney") & "")     '含税金额
            WglrGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = Abs(.Fields("consignMoney") & "")   '不含税金额
            WglrGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("remarksub"))          '备注
            WglrGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = Val(.Fields("taxrate"))             '税率
            WglrGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = Val(.Fields("unitPrice") & "")      '不含税单价
            '<<]
                   
            WglrGrid.RowHeight(Jsqte) = Sjhgd
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With
       
            
    '调整网格(Fixed)
    Call Sub_AdjustGrid
      
    '计算合计数据(Fixed)
    For Jsqte = Qslz To WglrGrid.Cols - 1
        Call Sjhj(Jsqte)
    Next Jsqte
    
    '将网格刷新解禁(Fixed)
    WglrGrid.Redraw = True
       
    '设置审核弃审按钮状态
    Call Sub_CheckStatus
       
End Sub

Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
     
    '屏蔽文本框,下拉组合框有效性判断
    Valilock = True
     
    '屏蔽网格失去焦点产生的有效性判断
    Changelock = True
         
    Select Case Button.Key
        Case "yl"                                            '预 览
            If Fun_Drfrmyxxpd Then
                BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, False
            End If
        Case "dy"                                            '打 印
            If Fun_Drfrmyxxpd Then
                Dim Yhanswer As Integer      '打印提示
                
                '用户确认是否打印单据
                Tsxx = "请确认是否打印当前单据?"
                Yhanswer = Xtxxts(Tsxx, 2, 2)
                If Yhanswer = 2 Then
                    Exit Sub
                End If
                BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, True
            End If
        Case "xz"                                            '新 增
            Call Sub_AddBill
        Case "xg"                                            '修 改
            Call Sub_EditBill
            XsFlag.Enabled = True
            LrText(1).Enabled = False
            LrText(2).Enabled = False
            If Trim(LrText(2).Text & "") <> "" Then
                LrText(3).Enabled = False
                LrText(4).Enabled = False
                XsFlag.Enabled = False
            End If
        Case "sc"                                            '删 除
            Call Sub_DeleteBill
        Case "zh"                                            '增 行
            Call zjlrfl
        Case "sh"                                            '删 行
            Call Scdqfl
        Case "bc"                                            '保 存
            If Fun_Drfrmyxxpd Then
                Call Sub_SaveBill
            End If
        Case "fq"                                            '放 弃
            Call Sub_AbandonBill
        Case "shsh"                                          '审 核
            Call Sub_CheckBill
        Case "shqs"                                          '弃 审
            Call Sub_AbandonCheck
        Case "first"                                         '首 张
            Call Sub_First
        Case "prev"                                          '上 张
            Call Sub_Prev
        Case "next"                                          '下 张
            Call Sub_Next
        Case "last"                                          '末 张
            Call Sub_Last
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
                Unload Me
    End Select
       
    '解 锁
    Valilock = False
    Changelock = False
    TextChangeLock = False
        
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)     '支持热键操作
    
    Select Case KeyCode
        Case vbKeyF5          '增加单据
            If Tlb_Action.Buttons("xz").Enabled And Tlb_Action.Buttons("xz").Visible Then
                Call Sub_AddBill
            End If
        Case vbKeyF3          '修改单据
            If Tlb_Action.Buttons("xg").Enabled And Tlb_Action.Buttons("xg").Visible Then
                Call Sub_EditBill
            End If
        Case vbKeyF6          '保存单据
            If Tlb_Action.Buttons("bc").Enabled And Tlb_Action.Buttons("bc").Visible Then
                If Fun_Drfrmyxxpd Then Call Sub_SaveBill
            End If
    End Select

End Sub

Private Sub Sub_OperStatus(Str_Status As String)                 '工具条依据不同状态所进行的变化
    
    With Tlb_Action
        '----------------自定义
        If Xs_IfConsign Then .Buttons("zh").Visible = False
        XsFlag.Enabled = False
        '----------------------
        
        Select Case Str_Status
            Case "10"   '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
                '工具条
                .Buttons("dy").Enabled = True       '打印
                .Buttons("yl").Enabled = True       '预览
                .Buttons("xz").Enabled = True       '新增
                .Buttons("xg").Enabled = True       '修改
                .Buttons("sc").Enabled = True       '删除
                .Buttons("zh").Enabled = False      '增行
                .Buttons("sh").Enabled = False      '删行
                .Buttons("bc").Enabled = False      '保存
                .Buttons("fq").Enabled = False      '放弃

⌨️ 快捷键说明

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