frmamendearning.frm

vb+sql 用于公交点钞结算和报表结合的相关软件

               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   240
            Left            =   90
            TabIndex        =   4
            Top             =   300
            Width           =   600
         End
      End
   End
End
Attribute VB_Name = "frmAmendEarning"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sOLDSXW  As String
Dim sOLDINPUT_DATE As String
Dim sOLDBUS_NO As String
Private Function NoToName(OpNo As String) As String
    Dim rs As New ADODB.Recordset
    If OpNo <> "" Then
        
        rs.Open "select opname,OP_NO from AMC_DCY_INFO where opno=" + Trim(OpNo), cnn, adOpenStatic, adLockOptimistic
        If rs.EOF Then
        Else
            NoToName = rs.Fields(0).Value
            txtDcOP_No = rs.Fields(1).Value
        End If
    End If
End Function

Private Function DrNoToName(OpNo As String) As String
    Dim rs As New ADODB.Recordset
    If OpNo <> "" Then
        rs.Open "select name from zz_bus_ic.dbo.Zy_Worker_INFO where op_no='" + Trim(OpNo) + "'", cnn, adOpenStatic, adLockOptimistic
        If rs.EOF Then
        Else
            DrNoToName = rs.Fields(0).Value
        End If
    End If
End Function

Private Sub cboOldSxw_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        txtDriverOldNo.SetFocus
    End If
End Sub

Private Sub cmbCompany_GotFocus()
    Dim rs As New ADODB.Recordset
    On Error Resume Next
    cmbCompany.ListIndex = -1
    rs.Open "select * from zz_bus_ic.dbo.ZY_line_bus_dept_view where line_no='" + txtLineNo + "'", cnn, adOpenStatic, adLockOptimistic
    If rs.EOF Then
        MsgBox "无此线路号，请检查重输!", vbExclamation, "提示."
        Exit Sub
    Else
        cmbCompany.Text = rs.Fields(1).Value
    End If

End Sub

Private Sub cmbSxw_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        txtDcOPNo.SetFocus
    End If
End Sub

Private Sub cmdCancel_Click()
    txtBusNo = ""
    txtCheckName = ""
    txtCheckNo = ""
    txtDcName = ""
    txtDcOPNo = ""
    txtDriverName = ""
    txtDriverNo = ""
    txtLineNo = ""
    txtM001 = ""
    txtM002 = ""
    txtM005 = ""
    txtM01 = ""
    txtM02 = ""
    txtM05 = ""
    txtM1 = ""
    txtM2 = ""
    txtM5 = ""
    txtM10 = ""
    txtM20 = ""
    txtM50 = ""
    txtM100 = ""
    txtToTalMoney = 0
    txtTotalNum = 0
    txtToTalTicket = 0
    cmbCompany.ListIndex = -1
End Sub

Private Sub cmdDel_Click()
    Dim sSxw As String
    Dim rs As New ADODB.Recordset
    On Error Resume Next
    Select Case cboOldSxw.ListIndex
        Case 0
            sSxw = 0
        Case 1
            sSxw = 1
        Case 2
            sSxw = 2
        Case 3
            sSxw = 3
        Case 4
            sSxw = 4
    End Select
    If MsgBox("确认要删除车号为『" + txtBusNos + "』的这条记录吗？", vbYesNo, "提示信息...") = vbYes Then
        rs.Open "ZYSP_DEL_CASH_INPUT '" + Trim(txtBusNos) + "','" + Format(dtpDateS, "yyyyMMdd") + "'," + sSxw + "," + Trim(txtDriverOldNo.Text), cnn, adOpenStatic, adLockOptimistic
        If Err.Number <> 0 Then
            MsgBox "删除失败？", vbCritical, "提示..."
        Else
            Call cmdCancel_Click
            MsgBox "删除成功", vbInformation, "提示..."
        End If
    End If
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    Dim acmd As New Command
    Dim param As ADODB.Parameter
    Dim rs As New ADODB.Recordset
    'On Error Resume Next
    If txtBusNos.Text = 0 Or txtDriverOldNo.Text = 0 Then
        MsgBox "补单不能进行修改!", vbExclamation, "提示."
        Exit Sub
    End If
    If txtLineNo = 0 Or txtDcOPNo = 0 Or txtCheckNo = 0 Or txtLineNo = "" Or cmbCompany.Text = "" Or txtDriverName = "" Or txtDcName = "" Then  'Or txtToTalMoney = 0 Or txtTotalNum = 0 Then
        MsgBox "数据录入不完整，请检查重输!", vbExclamation, "提示."
        Exit Sub
    End If
    With acmd
        .ActiveConnection = cnn
        .CommandText = "ZYSP_UPDATE_CASH_INPUT"
        .CommandType = adCmdStoredProc
        .Parameters("@DRIVEROPNO") = Trim(txtDriverNo)
        .Parameters("@INPUT_DATE") = Format(Trim(dtpDate), "yyyymmdd")
        .Parameters("@BUS_NO") = Trim(txtBusNo)
        .Parameters("@LINE_NO") = Trim(txtLineNo)
        rs.Open "select dept_no from zz_bus_ic.dbo.zy_dept_info where name='" + Trim(cmbCompany.Text) + "'", cnn, adOpenStatic, adLockOptimistic
        If Not rs.EOF Then
            .Parameters("@DEPT_NO") = rs.Fields(0).Value
        Else
            MsgBox "数据录入不完整，请检查重输!", vbExclamation, "提示..."
            Exit Sub
        End If
        .Parameters("@COUNTBILLOPNO") = Trim(txtDcOP_No)
        .Parameters("@CHECKOPNO") = Trim(txtDcOP_No) 'Trim(txtCheckNo)
        .Parameters("@M100") = Trim(txtM100)
        .Parameters("@M50") = Trim(txtM50)
        .Parameters("@M20") = Trim(txtM20)
        .Parameters("@M10") = Trim(txtM10)
        .Parameters("@M5") = Trim(txtM5)
        .Parameters("@M2") = Trim(txtM2)
        .Parameters("@M1") = Trim(txtM1)
        .Parameters("@M05") = Trim(txtM05)
        .Parameters("@M02") = Trim(txtM02)
        .Parameters("@M01") = Trim(txtM01)
        .Parameters("@M005") = Trim(txtM005)
        .Parameters("@M002") = Trim(txtM002)
        .Parameters("@M001") = Trim(txtM001)
        .Parameters("@SXW") = cmbSxw.ListIndex
        .Parameters("@DAYTOTALSUM") = Trim(txtTotalNum)
        .Parameters("@DAYTOTALMONEY") = CDbl(Trim(txtToTalMoney))
        .Parameters("@DAYTOTALTICKET") = Trim(txtToTalTicket)
        .Parameters("@oldsxw") = sOLDSXW
        .Parameters("@OLDINPUT_DATE") = CStr(sOLDINPUT_DATE)
        .Parameters("@OLDBUS_NO") = sOLDBUS_NO
        .Parameters("@OLDDRIVER_NO") = txtDriverOldNo
        .Execute '
        If Err.Number <> 0 Then
            MsgBox "数据输入失败! 此条记录已经录入不能重复输入!", , "提示..."
            Debug.Print Err.Description
        Else
            MsgBox "数据成功!", , "提示..."
            cmdOK.Enabled = False
        End If
        cmdCancel_Click
        txtBusNos.SetFocus

    End With
End Sub

Private Sub cmdSearch_Click()
    Dim sSxw As String
    Dim rs As New ADODB.Recordset
    Dim rs1 As New ADODB.Recordset
    On Error Resume Next
    Select Case cboOldSxw.ListIndex
        Case 0
            sSxw = 0
        Case 1
            sSxw = 1
        Case 2
            sSxw = 2
        Case 3
            sSxw = 3
        Case 4
            sSxw = 4
    End Select
'    rs.Open "select * from ZY_EARNING_INPUT where bus_no='" + txtBusNos + "' and convert(char(8),input_date,112)='" + Format(dtpDateS, "yyyyMMdd") + "' and sxw=" + sSxw + " and driveropno=" + Trim(txtDriverOldNo.Text), cnn, adOpenStatic, adLockOptimistic
    rs.Open "select * from ZY_EARNING_INPUT where bus_no=" + txtBusNos + " and input_date='" + Format(dtpDateS, "yyyyMMdd") + "' and sxw=" + sSxw + " and driver_opno=" + Trim(txtDriverOldNo.Text), cnn, adOpenStatic, adLockOptimistic
    If Not rs.EOF Then
        txtDriverNo = rs.Fields("DRIVER_OPNO")
        'dtpDate = rs.Fields("INPUT_DATE")
        dtpDate = dtpDateS
        sOLDINPUT_DATE = rs.Fields("INPUT_DATE")
        txtBusNo = rs.Fields("BUS_NO")
        sOLDBUS_NO = rs.Fields("BUS_NO")
        txtLineNo = rs.Fields("LINE_NO")
        cmbCompany.ListIndex = -1
        rs1.Open "select name from zz_bus_ic.dbo.zy_dept_info where dept_no=" + CStr(rs.Fields("dept_no")), cnn, adOpenStatic, adLockOptimistic
        If Not rs1.EOF Then
            cmbCompany.Text = Trim(rs1.Fields(0))
        End If
        rs1.Close
        
        txtDcOP_No = rs.Fields("COUNTBILL_OPNO")
        rs1.Open "select OPNO,OPname from AMC_dCY_info where OP_no=" + txtDcOP_No, cnn, adOpenStatic, adLockOptimistic
        If Not rs1.EOF Then
            txtDcOPNo = Trim(rs1.Fields(0))
            txtCheckNo = Trim(rs1.Fields(0))
            txtDcName = Trim(rs1.Fields(1))
            txtCheckName = Trim(rs1.Fields(1))
        End If
        rs1.Close
        
        'txtCheckNo = rs.Fields("CHECK_OPNO")
        txtM100 = rs.Fields("M100")
        txtM50 = rs.Fields("M50")
        txtM20 = rs.Fields("M20")
        txtM10 = rs.Fields("M10")
        txtM5 = rs.Fields("M5")
        txtM2 = rs.Fields("M2")
        txtM1 = rs.Fields("M1")
        txtM05 = rs.Fields("M05")
        txtM02 = rs.Fields("M02")
        txtM01 = rs.Fields("M01")
        txtM005 = rs.Fields("M005")
        txtM002 = rs.Fields("M002")
        txtM001 = rs.Fields("M001")
        cmbSxw.ListIndex = rs.Fields("SXW")
        sOLDSXW = rs.Fields("SXW")
        cmdOK.Enabled = True
        sumMonetNum
        txtDriverNo_LostFocus
        'txtDcOPNo_LostFocus
    Else
        Call MsgBox("没有找到相应的记录,请核实候重新查询？", , "提示...")
    End If

    dtpDate.SetFocus
End Sub

Private Sub cmdSearch_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        dtpDate.SetFocus
    End If
End Sub

Private Sub cmdSearch_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        dtpDate.SetFocus
    End If
End Sub

Private Sub dtpDate_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        txtBusNo.SetFocus
    End If
End Sub

Private Sub dtpDateS_Change()
    cmdOK.Enabled = False
End Sub

Private Sub dtpDateS_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        cboOldSxw.SetFocus
    End If
End Sub

Private Sub Form_Load()
    dtpDate = DateAdd("d", -1, Now)
    dtpDateS = DateAdd("d", -1, Now)
    Dim rs As New ADODB.Recordset
    Set rs = New ADODB.Recordset
    rs.Open "select * from ZZ_BUS_IC.DBO.zy_dept_info where DEPT_NO<80 AND is_trans=1", cnn, adOpenStatic, adLockOptimistic
    i = 0
    Do While Not rs.EOF
        cmbCompany.AddItem rs.Fields(1).Value
        rs.MoveNext
    Loop
    cmbSxw.ListIndex = 0
    cmbCompany.ListIndex = -1
    cboOldSxw.ListIndex = 0
End Sub

Private Sub txtBusNo_Change()
    If Not IsNumeric(txtBusNo) Then
        txtBusNo = 0
    End If
End Sub

Private Sub txtBusNo_GotFocus()
    txtBusNo.SelLength = Len(txtBusNo)
End Sub

Private Sub txtBusNo_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        txtDriverNo.SetFocus
    End If
End Sub

Private Sub txtBusNo_LostFocus()
    
    Dim rs As New ADODB.Recordset
    On Error Resume Next
    'txtLineNo = ""
    cmbCompany.ListIndex = -1
    If Trim(txtBusNo) = "0" Then
        MsgBox "漏填车辆号，请确认!", vbExclamation, "提示..."
    End If
    
    rs.Open "select * from zz_bus_ic.dbo.ZY_line_bus_dept_view where bus_no='" + txtBusNo + "'", cnn, adOpenStatic, adLockOptimistic
    If rs.EOF Then
        MsgBox "无此车辆号，请检查重输!", vbExclamation, "提示."
        
        txtLineNo.SetFocus
        Exit Sub
    Else
        txtLineNo = rs.Fields(3).Value
        cmbCompany.Text = Trim(rs.Fields(1).Value)
        txtLineNo.SetFocus
    End I