frminputearning.frm

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

               Name            =   "宋体"
               Size            =   12
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   240
            Index           =   4
            Left            =   2760
            TabIndex        =   30
            Top             =   375
            Width           =   1200
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Caption         =   "所属公司："
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   12
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   240
            Index           =   5
            Left            =   120
            TabIndex        =   29
            Top             =   1620
            Width           =   1200
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Caption         =   "上/下午："
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   12
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   240
            Index           =   6
            Left            =   2760
            TabIndex        =   28
            Top             =   1140
            Width           =   1080
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Caption         =   "点钞员工号："
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   12
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   330
            Index           =   13
            Left            =   90
            TabIndex        =   27
            Top             =   2280
            Width           =   1470
            WordWrap        =   -1  'True
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Caption         =   "复核员工号："
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   12
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   240
            Index           =   14
            Left            =   4440
            TabIndex        =   26
            Top             =   2280
            Width           =   1440
         End
      End
   End
End
Attribute VB_Name = "frmInputConEarning"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim nobusno As Boolean
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 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
        rs.Close
        rs.Open "select coins_price from zz_bus_ic.dbo.zy_line_info where line_no=" + txtLineNo + "", cnn, adOpenStatic, adLockOptimistic
        If rs.EOF Then
            MsgBox "无此线路票价，请与管理员联系!", vbExclamation, "提示."
            Exit Sub
        Else
            TxtAvePrice.Text = rs(0).Value
        End If
    End If

End Sub

Private Sub cmbCompany_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        txtDriverNo.SetFocus
    End If
End Sub

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

Private Sub cmdCancel_Click()
    txtBusNo = ""
    txtCheckName = ""
    txtCheckNo = ""
    txtDcName = ""
    txtDcOPNo = ""
    txtDriverName = ""
    txtDriverNo = ""
    txtConductorName = ""
    txtConductorNo = ""
    TxtAvePrice = ""
    txtLineNo = ""
    txtM001 = ""
    txtM002 = ""
    txtM005 = ""
    txtM01 = ""
    txtM02 = ""
    txtM05 = ""
    txtM1 = ""
    txtM2 = ""
    txtM5 = ""
    txtM10 = ""
    txtM20 = ""
    txtM50 = ""
    txtM100 = ""
    txtToTalMoney = 0
    txtTotalNum = 0
End Sub

Private Sub cmdDel_Click()
    
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
    If txtLineNo = 0 Or txtDcOPNo = 0 Or txtCheckNo = 0 Or txtLineNo = "" Or cmbCompany.Text = "" Or txtDriverName = "" Or txtDcName = "" Or txtToTalMoney = 0 Or txtTotalNum = 0 Then
        MsgBox "数据录入不完整，请检查重输!", vbExclamation, "提示..."
        Exit Sub
    End If
    'On Error Resume Next
    With acmd
        .ActiveConnection = cnn
        .CommandText = "ZYSP_INSERT_CON_CASH_INPUT"
        .CommandType = adCmdStoredProc
        .Parameters("@DRIVEROPNO") = Trim(txtDriverNo)
        .Parameters("@CONDUCTOROPNO") = Trim(txtConductorNo)
        .Parameters("@INPUT_DATE") = Trim(dtpDate)
        .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("@AvePrice") = CDbl(Trim(TxtAvePrice))
        .Parameters("@DAYTOTALTICKET") = Trim(txtTotalNum)
        .Parameters("@DAYTOTALMONEY") = CDbl(Trim(txtToTalMoney))
        .Execute '
        If Err.Number <> 0 Then
            MsgBox "数据输入失败! 此条记录已经录入不能重复输入!", , "提示..."
            Debug.Print Err.Description
        Else
            MsgBox "数据成功!", , "提示..."
        End If
        txtBusNo.SetFocus
        cmdCancel_Click
    End With
End Sub


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

Private Sub Form_Load()
    dtpDate = Format(DateAdd("d", -1, Now), "yyyyMMdd")
    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
    txtCheckNo = cCheckOP
    txtCheckName = Trim(cCheckName)
    cmbSxw.ListIndex = 0
    cmbCompany.ListIndex = 0
End Sub

Private Sub Form_Resize()
'    If WindowState <> 2 Then
'        Width = 9800
'        Height = 6660
'    End If
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
        txtLineNo.SetFocus
    End If
End Sub


Private Sub txtBusNo_LostFocus()
    
    Dim rs As New ADODB.Recordset
'    On Error Resume Next
    txtLineNo = ""
    cmbCompany.ListIndex = 0
    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, "提示..."
        nobusno = True
        
        txtLineNo.SetFocus
        Exit Sub
    Else
        txtLineNo = rs.Fields(3).Value
        cmbCompany = CStr(rs.Fields(1).Value)
        txtLineNo.SetFocus
    End If
    
End Sub

Private Sub txtCheckNo_Change()
    If Not IsNumeric(txtCheckNo) Then
        txtCheckNo = 0
    End If
End Sub

Private Sub txtCheckNo_GotFocus()
    txtCheckNo.SelLength = Len(txtCheckNo)
End Sub

Private Sub txtCheckNo_LostFocus()
    txtCheckName = NoToName(Trim(txtCheckNo))
    If txtCheckName = "" Then
        MsgBox "无此复核员工号，请检查重输!", vbExclamation, "提示..."
        Exit Sub
    End If
End Sub

Private Sub txtConductorNo_Change()
    If Not IsNumeric(txtConductorNo) Then
        txtConductorNo = 0
    End If

End Sub

Private Sub txtConductorNo_GotFocus()
    txtConductorNo.SelLength = Len(txtConductorNo)
End Sub

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

End Sub

Private Sub txtConductorNo_LostFocus()
    If txtConductorNo.Text = "" Then
        txtConductorNo = "0"
        txtConductorName = "补单"
    End If
    txtConductorName = DrNoToName(Trim(txtConductorNo))
    If txtConductorName = "" Then
        'MsgBox "无此司机工号，请检查重输!", vbExclamation, "提示..."
        txtConductorName = "补单"
        Exit Sub
    End If

End Sub

Private Sub txtDcOPNo_Change()
    If Not IsNumeric(txtDcOPNo) Then
        txtDcOPNo = 0
    End If
End Sub

Private Sub txtDcOPNo_GotFocus()
    txtDcOPNo.SelLength = Len(txtDcOPNo)
End Sub