+

VB开发的ERP系统

Private Sub Sub_Sjgskz(WglrGrid As VSFlexGrid, zsws As Integer, xsws As Integer)                  '保证数值录入字段录入格式

    '输入参数:sjwb 录入的值 zsws 数值录入限制整数位数 xsws 数值录入限制小数位数
   
    Dim bccrd%
    Dim Ws, Zswstr, Xswstr As String
    Dim B_fu As Boolean
    Dim sjzws As Integer
    Dim Sjwb As String
    
    Sjwb = WglrGrid.EditText
    bccrd = WglrGrid.EditSelStart
    B_fu = False
   
    Ws = InStr(1, Sjwb, "-")
    If Ws > 0 Then Sjwb = Mid(Sjwb, Ws)

    If Left(Sjwb, 1) = "-" Then
        B_fu = True
        zsws = zsws - 1
        Zswstr = Mid(Sjwb, 2)
    Else
        Zswstr = Mid(Sjwb, 1)
    End If
   
    Ws = InStr(1, Zswstr, ".")                   '整数位数+1
   
    If Ws > 0 Then
        If zsws > Ws - 1 Then
            Zswstr = Mid(Zswstr, 1, Ws - 1) + Mid(Zswstr, Ws, xsws + 1)
        Else
            Zswstr = Mid(Zswstr, 1, zsws) + Mid(Zswstr, Ws, xsws + 1)
            Ws = InStr(1, Zswstr, ".")                   '整数位数+1
        End If
        Ws = Len(Zswstr) - Ws                   '小数位数
        If Left(Zswstr, 1) = "." Then
            bccrd = bccrd + 1
            Zswstr = "0" & Zswstr
        End If
        If Ws < xsws Then
           Zswstr = Format(Zswstr, "#0." + String(Ws, "0"))
        Else
           Zswstr = Format(Zswstr, "#0." + String(xsws, "0"))
        End If
    Else
        Zswstr = Mid(Zswstr, 1, zsws)
        Zswstr = Format(Zswstr)
    End If
   
    If B_fu Then Zswstr = "-" & Zswstr
    WglrGrid.EditText = Zswstr
    WglrGrid.EditSelStart = bccrd

End Sub

'以下为网格选中操作
Private Sub CxbbGrid_DblClick()
    
    With CxbbGrid
        If .Row = .Rows - 1 Then Exit Sub
        If .Col = Sydz("009", GridStr(), Szzls) Then
            If .TextMatrix(.Row, Sydz("009", GridStr(), Szzls)) Then
                .TextMatrix(.Row, Sydz("009", GridStr(), Szzls)) = False
            Else
                .TextMatrix(.Row, Sydz("009", GridStr(), Szzls)) = True
            End If
            Exit Sub
        End If
        If .Col <> Sydz("008", GridStr(), Szzls) Then
            If Not Trim(.TextMatrix(.Row, Sydz("002", GridStr(), Szzls))) And Abs(Val(.TextMatrix(.Row, Sydz("007", GridStr(), Szzls)))) > 0 Then
                .TextMatrix(.Row, Sydz("002", GridStr(), Szzls)) = True
                .TextMatrix(.Row, Sydz("009", GridStr(), Szzls)) = True
                .TextMatrix(.Row, Sydz("008", GridStr(), Szzls)) = Val(.TextMatrix(.Row, Sydz("007", GridStr(), Szzls)))
                .TextMatrix(.Rows - 1, Sydz("008", GridStr(), Szzls)) = Val(.TextMatrix(.Rows - 1, Sydz("008", GridStr(), Szzls))) + Val(.TextMatrix(.Row, Sydz("008", GridStr(), Szzls)))
            Else
                .TextMatrix(.Rows - 1, Sydz("008", GridStr(), Szzls)) = Val(.TextMatrix(.Rows - 1, Sydz("008", GridStr(), Szzls))) - Val(.TextMatrix(.Row, Sydz("008", GridStr(), Szzls)))
                .TextMatrix(.Row, Sydz("002", GridStr(), Szzls)) = False
                .TextMatrix(.Row, Sydz("009", GridStr(), Szzls)) = False
                .TextMatrix(.Row, Sydz("008", GridStr(), Szzls)) = ""
            End If
        Else
            .EditCell
            .CellBackColor = Ydtext.BackColor
            .EditText = "" & .EditText
            .EditSelStart = Len(Trim(.EditText))
            .TextMatrix(.Rows - 1, Sydz("008", GridStr(), Szzls)) = Val(.TextMatrix(.Rows - 1, Sydz("008", GridStr(), Szzls))) - Val(.TextMatrix(.Row, Sydz("008", GridStr(), Szzls)))
        End If
    End With
    
End Sub

Private Sub CxbbGrid1_DblClick()

    With CxbbGrid1
        If .Row = .Rows - 1 Then Exit Sub
        If .Col <> Sydz("007", GridStr(), Szzls) Then
            If Not Trim(.TextMatrix(.Row, Sydz("002", GridStr(), Szzls))) And Abs(Val(.TextMatrix(.Row, Sydz("006", GridStr(), Szzls)))) > 0 Then
                .TextMatrix(.Row, Sydz("002", GridStr(), Szzls)) = True
                .TextMatrix(.Row, Sydz("007", GridStr(), Szzls)) = Val(.TextMatrix(.Row, Sydz("006", GridStr(), Szzls)))
                .TextMatrix(.Rows - 1, Sydz("007", GridStr(), Szzls)) = Val(.TextMatrix(.Rows - 1, Sydz("007", GridStr(), Szzls))) + Val(.TextMatrix(.Row, Sydz("007", GridStr(), Szzls)))
            Else
                .TextMatrix(.Rows - 1, Sydz("007", GridStr(), Szzls)) = Val(.TextMatrix(.Rows - 1, Sydz("007", GridStr(), Szzls))) - Val(.TextMatrix(.Row, Sydz("007", GridStr(), Szzls)))
                .TextMatrix(.Row, Sydz("002", GridStr(), Szzls)) = False
                .TextMatrix(.Row, Sydz("007", GridStr(), Szzls)) = ""
            End If
        Else
            .EditCell
            .CellBackColor = Ydtext.BackColor
            .EditText = "" & .EditText
            .EditSelStart = Len(Trim(.EditText))
            .TextMatrix(.Rows - 1, Sydz("007", GridStr(), Szzls)) = Val(.TextMatrix(.Rows - 1, Sydz("007", GridStr(), Szzls))) - Val(.TextMatrix(.Row, Sydz("007", GridStr(), Szzls)))
        End If
    End With
    
End Sub

Private Sub Sub_SelectAll()                            '全选
    Dim SumTemp As Double

    With CxbbGrid
        SumTemp = 0
        For Jsqte = .FixedRows To .Rows - 2
            If Val(.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls))) <> 0 Then
                .TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = True
                .TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = True
                .TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = .TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls))
                SumTemp = SumTemp + Val(.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)))
            End If
        Next Jsqte
        .TextMatrix(.Rows - 1, Sydz("008", GridStr(), Szzls)) = SumTemp
    End With
    With CxbbGrid1
        SumTemp = 0
        For Jsqte = .FixedRows To .Rows - 2
            If Val(.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls))) <> 0 Then
                CxbbGrid1.TextMatrix(Jsqte, Sydz("002", GridStr1(), Szzls1)) = True
                .TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = .TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls))
                SumTemp = SumTemp + Val(.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)))
            End If
        Next Jsqte
        .TextMatrix(.Rows - 1, Sydz("007", GridStr(), Szzls)) = SumTemp
    End With
End Sub

Private Sub Sub_AbandonAll()                            '全消
    With CxbbGrid
        For Jsqte = .FixedRows To .Rows - 1
            .TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = False
            .TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = False
            .TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = ""
        Next Jsqte
    End With
    With CxbbGrid1
        For Jsqte = .FixedRows To .Rows - 1
            .TextMatrix(Jsqte, Sydz("002", GridStr1(), Szzls1)) = False
            .TextMatrix(Jsqte, Sydz("007", GridStr1(), Szzls1)) = ""
        Next Jsqte
    End With
End Sub

Private Sub Sub_SaveData()                              '核销存盘
    Dim Jsq As Long
    Dim strTemp As String
    Dim RsTemp As New ADODB.Recordset
    Dim BlTemp As Boolean
    Dim RecTemp As New ADODB.Recordset
    Dim TempId As Double
    Dim ExchRate As Long
    Dim ConvertFlag As Boolean
    Dim CreateCode As String
        
    BlTemp = False
    With CxbbGrid
        For Jsq = .FixedRows To .Rows - 2
            If Trim(.TextMatrix(Jsq, Sydz("002", GridStr(), Szzls))) Or Trim(.TextMatrix(Jsq, Sydz("009", GridStr(), Szzls))) Then
                BlTemp = True
            End If
        Next
    End With
    With CxbbGrid1
        For Jsq = .FixedRows To .Rows - 2
            If .TextMatrix(Jsq, Sydz("002", GridStr(), Szzls)) Then
                BlTemp = True
            End If
        Next
    End With
    If Not BlTemp Then
        Tsxx = "请选定核销数据!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Sub
    End If
    
    If Val(CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Sydz("008", GridStr(), Szzls))) <> Val(CxbbGrid1.TextMatrix(CxbbGrid1.Rows - 1, Sydz("007", GridStr(), Szzls))) Then
        Tsxx = "货单金额与回款金额不符!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Sub
    End If
    
    On Error GoTo Swcwcl
    Cw_DataEnvi.DataConnect.BeginTrans
        CreateCode = CreatBillCode(1409, True)
        strTemp = "select * from Xs_MoneyWare where 1=2"
        RsTemp.Open strTemp, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With RsTemp
            For Jsq = CxbbGrid.FixedRows To CxbbGrid.Rows - 2
                If Trim(CxbbGrid.TextMatrix(Jsq, Sydz("002", GridStr(), Szzls))) Or Trim(CxbbGrid.TextMatrix(Jsq, Sydz("009", GridStr(), Szzls))) Then
                    TempId = Val(CxbbGrid.TextMatrix(Jsq, 0))         '单据Id
                    '回写核销关系表
                    .AddNew
                    .Fields("MoneyWareCode") = CreateCode        '标识为同次核销
                    .Fields("kjyear") = Xtyear
                    .Fields("period") = Xtmm
                    .Fields("billtype") = 1
                    .Fields("billid") = TempId
                    .Fields("MoneyWareSubId") = Val(CxbbGrid.TextMatrix(Jsq, Sydz("001", GridStr(), Szzls)))
                    .Fields("billcode") = CxbbGrid.TextMatrix(Jsq, Sydz("004", GridStr(), Szzls))           '单据号
                    .Fields("cuscode") = Custom.Tag
                    .Fields("warecode") = CxbbGrid.TextMatrix(Jsq, 1)
                    .Fields("CapitalUsedMoney") = Val(CxbbGrid.TextMatrix(Jsq, Sydz("008", GridStr(), Szzls)))
                    .Fields("verifier") = Xtczy
                    .Fields("verifierdate") = Format(Xtrq, "yyyy-mm-dd")
                    .Update
                    '回填发货单
                    Sqlstr = "select * from xs_consignbillmain where ConsignBillMainID='" & TempId & "'"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                        ExchRate = Trim(RecTemp.Fields("exchrate"))         '汇率
                        ConvertFlag = Trim(RecTemp.Fields("convertflag"))   '折算方式
                        RecTemp.Close
                    Sqlstr = "select * from Xs_ConsignBillsub where ConsignBillMainID='" & TempId & "' and warecode='" & Trim(CxbbGrid.TextMatrix(Jsq, 1)) & "'"
                    RecTemp.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                        RecTemp.Fields("CapReturnMoney") = RecTemp.Fields("capreturnmoney") + .Fields("CapitalUsedMoney")
                        If ConvertFlag Then
                            RecTemp.Fields("returnmoney") = RecTemp.Fields("returnmoney") + Format(.Fields("CapitalUsedMoney") * ExchRate, "###0." + String(Xtjexsws, "0"))
                        Else
                            RecTemp.Fields("returnmoney") = RecTemp.Fields("returnmoney") + Format(.Fields("CapitalUsedMoney") / ExchRate, "###0." + String(Xtjexsws, "0"))
                        End If
                        If CxbbGrid.TextMatrix(Jsq, Sydz("009", GridStr(), Szzls)) Then
                            RecTemp.Fields("settleallflag") = 1
                        End If
                        RecTemp.Update
                        RecTemp.Close
                End If
            Next
            For Jsq = CxbbGrid1.FixedRows To CxbbGrid1.Rows - 2
                If Trim(CxbbGrid1.TextMatrix(Jsq, Sydz("002", GridStr(), Szzls))) Then
                    TempId = Val(CxbbGrid1.TextMatrix(Jsq, 0))         '单据Id
                    '回写核销关系表
                    .AddNew
                    .Fields("MoneyWareCode") = CreateCode        '标识为同次核销
                    .Fields("kjyear") = Xtyear
                    .Fields("period") = Xtmm
                    .Fields("billtype") = 0
                    .Fields("billid") = TempId
                    .Fields("MoneyWareSubId") = Val(CxbbGrid1.TextMatrix(Jsq, Sydz("001", GridStr(), Szzls)))
                    .Fields("billcode") = CxbbGrid1.TextMatrix(Jsq, Sydz("004", GridStr(), Szzls))           '单据号
                    .Fields("cuscode") = Custom.Tag
                    .Fields("CapitalUsedMoney") = Val(CxbbGrid1.TextMatrix(Jsq, Sydz("007", GridStr(), Szzls)))
                    .Fields("verifier") = Xtczy
                    .Fields("verifierdate") = Format(Xtrq, "yyyy-mm-dd")
                    .Update
                    '回填回款表
                    Sqlstr = "Update Xs_ReturnMoney set CapitalRemainMoney=CapitalRemainMoney-(" & Val(.Fields("CapitalUsedMoney")) & ") Where ReturnMoneyID='" & TempId & "'"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                End If
            Next
        End With
    Cw_DataEnvi.DataConnect.CommitTrans
    
    SzToolbar.Buttons("qbxz").Enabled = False   '全选
    SzToolbar.Buttons("qbqx").Enabled = False   '全消
    SzToolbar.Buttons("hx").Enabled = False     '核销（存盘）
    
    Tsxx = "单据核销完毕! "
    Call Xtxxts(Tsxx, 0, 4)
    Exit Sub
    
Swcwcl:                             '数据存盘时出现错误
    Cw_DataEnvi.DataConnect.RollbackTrans
        Tsxx = "核销过程中出现未知错误,程序自动恢复保存前状态!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
End Sub


'==============================将来删除============================
Private Sub GsToolbar_ButtonClick(Index As Integer, ByVal Button As MSComctlLib.Button)
    If Index = 1 Then
        Select Case Button.Key
            Case "bcgs"                                          '保存表格格式
                Call Bcwggs(CxbbGrid1, GridCode1, GridStr())
            Case "hfmrgs"                                        '恢复默认格式
                Call Hfmrgs(CxbbGrid1, GridCode1, GridStr())
            Case "szxsxm"                                        '设置显示项目
                Call Szxsxm(CxbbGrid1, GridCode1)
        End Select
    Else
        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 If
End Sub