frm_期初录入 .frm

农村水电费记帐录入

Dim strMan As String
Dim Indate As String
Dim i As Integer
Dim rowi As Integer
With grdmain
    For i = 1 To .Rows - 1
    rowi = Chkgrd(i)
    If rowi <> 1 Then
          If i = .Rows - 1 Then
            If MsgBox("最后一行录入是否有效?", vbYesNo, "系统提示") = vbYes Then
                Exit Sub
            Else
                grdmainlns = grdmainlns - 1
                Exit For
            End If
          Else
            MsgBox "请检查第" & i & "行" & Trim(.TextMatrix(0, 0 - rowi)) & "是否正确!", , "系统提示"
              Exit Sub
        End If
    End If
    Next i
End With


With rsUser
 If .State = adStateOpen Then .Close
 .Open "select  * from 用户信息 ", strcnn, adOpenKeyset, adLockBatchOptimistic
End With

With grdmain
    For i = 1 To grdmainlns
            With rsUser   'ws产品接收记录表
                If Not .BOF Then .MoveFirst
                .Find "用户编号='" & Trim(grdmain.TextMatrix(i, 1)) & "'"
                If Not .BOF And Not .EOF Then
                .Fields("用户编号") = Trim(grdmain.TextMatrix(i, 1))
                .Fields("欠费月份") = Format("20" & left(Trim(grdmain.TextMatrix(i, 4)), 2) & "-" & Right(Trim(grdmain.TextMatrix(i, 4)), 2) & "-01", "yymm")
                .Fields("欠费金额") = Trim(grdmain.TextMatrix(i, 3))
                .Fields("欠费登记") = 1
                'If Trim(grdmain.TextMatrix(i, 10)) <> "" Then .Fields("备注") = Trim(grdmain.TextMatrix(i, 10))
               ' .Fields("录入人") = Trim(frmlogin.InOp)
               ' .Fields("交费日期") = Format(Now(), "yyyy-mm-dd")
               ' .Fields("记录类型") = 1
                Else
                    MsgBox "用户" & Trim(grdmain.TextMatrix(i, 2)) & "在数据库中找不到,请检查录入编号与姓名是否一至!"
                    Exit Sub
                End If
            End With
    Next i
End With
strcnn.BeginTrans
    rsUser.UpdateBatch
strcnn.CommitTrans
rsUser.Close
MsgBox "已经保存到数据库中！", , "系统提示"
Start True
End Sub

Private Sub Form_Load()
Dim i As Integer
Dim j As Integer
'chg.Change Me
    frm_test_startwidth = Me.width
    frm_test_startheight = Me.height
With strcnn
    If .State = adStateOpen Then .Close
    .Open cnn
End With
'DtpOut.Value = Format(Now(), "yyyy 年 MM月")

colname = Array("序号", "用户编号", "用户名称", "期初金额", "欠费月份", "欠款登记", "未用", "未用", "未用", "未用", "说明")
colwtd = Array(800, 1000, 1200, 800, 800, 0, 0, 0, 0, 0, 1600)
coltype = Array(0, 3, 3, 2, 0, 2, 2, 2, 2, 2, 0)
collock = Array(1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0)
With AdoID
    .ConnectionString = strcnn
    .RecordSource = "select 用户编号,姓名,欠款,欠费登记,月份 from v_用户期初数据 " & " order by 用户编号"
    Debug.Print .RecordSource
    .Refresh
End With
With Adoname
    .ConnectionString = strcnn
    .RecordSource = "select 用户编号,姓名,欠款  ,欠费登记,月份 ,selcol from v_用户期初数据 " & " order by selcol"
    .Refresh
End With

With grdmain
    .Cols = UBound(colname) + 1
    .Rows = 2
    .FixedCols = 1
    .FixedRows = 1
    For i = 0 To .Cols - 1
        .TextMatrix(0, i) = colname(i)
        .ColWidth(i) = colwtd(i)
        .ColInputType(i) = coltype(i)
        .ColLocked(i) = collock(i)
        .ColAlignment(i) = flexAlignCenterCenter
    Next i
    

    Set .ListDataSource(2) = Adoname
    .ListSelectCol(2) = 5
    .ShowListHeader(2) = True
    .ListWidth(2) = 4300
    .ListRows(2) = 10
    .ListSearchMode(2) = LinearSearch
    .ListAutoFind(2) = True
    .Editable = True
    .ListColWidth(2, 1) = 1000 '姓名
    .ListColWidth(2, 0) = 800 '用户编号
    .ListColWidth(2, 2) = 800 '应交金额
    .ListColWidth(2, 3) = 800 '上月欠款
    .ListColWidth(2, 4) = 0 '欠款登记
    .ListColAlignment(2, 0) = flexAlignLeftCenter
    .ListColAlignment(2, 1) = flexAlignLeftCenter
    .ListColAlignment(2, 2) = flexAlignCenterCenter
    .ListColAlignment(2, 3) = flexAlignCenterCenter
    .ListColResize(2) = True
    

    
    Set .ListDataSource(1) = AdoID
    .ListSelectCol(1) = 0
    .ShowListHeader(1) = True
    .ListWidth(1) = 4300
    .ListRows(1) = 10
    .ListSearchMode(1) = LinearSearch
    .ListAutoFind(1) = True
    .Editable = True
    .ListColWidth(1, 1) = 1000 '姓名
    .ListColWidth(1, 0) = 800 '用户编号
    .ListColWidth(1, 2) = 800 '应交金额
    .ListColWidth(1, 3) = 800 '上月欠款
    .ListColWidth(1, 4) = 0 '欠款登记
    .ListColAlignment(1, 0) = flexAlignLeftCenter
    .ListColAlignment(1, 1) = flexAlignLeftCenter
    .ListColAlignment(1, 2) = flexAlignCenterCenter
    .ListColAlignment(1, 3) = flexAlignCenterCenter
    .ListColResize(1) = True


End With
Start True
End Sub


Private Sub GrdMain_KeyPress(KeyAscii As Integer)
With grdmain
    If .Col = 2 And KeyAscii > 64 And KeyAscii < 91 Then
        KeyAscii = Asc(LCase(Chr(KeyAscii)))
    End If
    If .Col = 1 And Not IsNumeric(Chr(KeyAscii)) And KeyAscii > 31 Then
        KeyAscii = 0
    End If

End With
End Sub

Private Sub grdMain_Selected(Row As Integer, Col As Integer, Value As String)
Dim i As Integer
Dim j As Integer
       Dim a()     As String

With grdmain
    If .Col = 1 Then

       a = Split(Value, Chr(9))
        If a(3) Then
            MsgBox "用户" & a(1) & "20" & left(Trim(a(4)), 2) & "年" & Right(Trim(a(4)), 2) & "月的欠费已经录入" & Trim(a(2)) & "元,不能再次录入"
            For i = 1 To .Cols - 1
                .TextMatrix(.Row, i) = ""
            Next i
            Exit Sub
        End If
        If Trim(a(1)) <> "" Then .TextMatrix(Row, 2) = Trim(a(1))    '姓名
        If Trim(a(0)) <> "" Then .TextMatrix(Row, 1) = Trim(a(0)) ' 用户编号
        If Trim(a(2)) <> "" Then .TextMatrix(Row, 3) = Trim(a(2))    '欠款
        .TextMatrix(Row, 5) = a(3)    '欠款登记
    End If
    If .Col = 2 Then
       a = Split(Value, Chr(9))
        If a(3) Then
            MsgBox "用户" & a(1) & "20" & left(Trim(a(4)), 2) & "年" & Right(Trim(a(4)), 2) & "月的欠费已经录入" & Trim(a(2)) & "元,不能再次录入"
            For i = 1 To .Cols - 1
                .TextMatrix(.Row, i) = ""
            Next i
            Exit Sub
        End If
        If Trim(a(1)) <> "" Then .TextMatrix(Row, 2) = Trim(a(1))    '姓名
        If Trim(a(0)) <> "" Then .TextMatrix(Row, 1) = Trim(a(0)) ' 用户编号
        If Trim(a(2)) <> "" Then .TextMatrix(Row, 3) = Trim(a(2))    '应交
        .TextMatrix(Row, 5) = a(3)    '欠款登记
    End If
End With

End Sub

Private Sub grdMain_KeyUp(KeyCode As Integer, Shift As Integer)
With grdmain
If (.Col = 2 Or .Col = 1) And .Row > 0 Then
    If Not .IsDropDown Then
        If KeyCode <> vbKeyLeft And KeyCode <> vbKeyRight And KeyCode <> vbKeyReturn Then .BeginDropDown
    End If
End If
End With
End Sub
Private Sub grdmain_RowFinal(Row As Integer)
Dim i As Integer
With grdmain
    
    If grdmainlns = .Row Then
        rowi = Chkgrd(.Row)
        If rowi <> 1 Then
            MsgBox "请检查" & Trim(.TextMatrix(0, 0 - rowi)) & "是否正确!", , "系统提示"
            .Col = 0 - rowi
            Exit Sub
        Else
            .Rows = .Rows + 1
            grdmainlns = grdmainlns + 1
            .TextMatrix(.Rows - 1, 0) = Format(.Rows - 1, "000")
            Exit Sub
        End If
    End If
End With
End Sub


Private Function Start(isCanUse As Boolean) 'iscanuse 是真时是初始状态,添加按钮可用
Dim i As Integer
With grdmain
    AdoID.Refresh
    Adoname.Refresh
    grdmainlns = 1
    .Rows = 1
    .Rows = 2
    .FixedRows = 1
    .FixedCols = 1
    For i = 0 To .Cols - 1
        .TextMatrix(0, i) = colname(i)
    Next i
    .Editable = Not isCanUse
            .Col = 1
        .TextMatrix(1, 0) = "001"

End With
'DtpOut.Enabled = isCanUse
Me.KeyPreview = isCanUse
CmdAdd.Enabled = isCanUse
CmdSave.Enabled = Not isCanUse
CmdEsc.Enabled = Not isCanUse
CmdExit.Enabled = isCanUse
End Function

Private Function Chkgrd(rowi As Integer) As Integer
Dim sum As Integer
Dim i As Integer
Dim j As Integer
With grdmain
'产品名称
If Trim(.TextMatrix(rowi, 1)) = "" Then '用户编号
    Chkgrd = -1
    Exit Function
End If
If Trim(.TextMatrix(rowi, 2)) = "" Then '用户姓名
    Chkgrd = -2
    Exit Function
End If
If Trim(.TextMatrix(rowi, 3)) = "" Then  '实交金额
    Chkgrd = -3
    Exit Function
End If

If Not IsDate("20" & left(Trim(.TextMatrix(rowi, 4)), 2) & "-" & Right(Trim(.TextMatrix(rowi, 4)), 2) & "-01") Or Len(Trim(.TextMatrix(rowi, 4))) <> 4 Or Val(left(Trim(.TextMatrix(rowi, 4)), 2)) < 6 Then  '欠费月份
    Chkgrd = -4
    Exit Function
End If
For i = 1 To .Rows - 1
    If i <> rowi And Trim(.TextMatrix(rowi, 1)) = Trim(.TextMatrix(i, 1)) Then
        Chkgrd = -1
        For j = 1 To .Cols - 1
            .TextMatrix(.Row, j) = ""
        Next j
        Exit Function
    End If
Next i
With AdoID.Recordset
    If Not .BOF Then .MoveFirst
    .Find "用户编号='" & Trim(grdmain.TextMatrix(rowi, 1)) & "'"
    If Not .BOF And Not .EOF Then
        If Trim(.Fields("姓名")) = Trim(grdmain.TextMatrix(rowi, 2)) Then
            Chkgrd = 1
            Exit Function
        Else
            Chkgrd = -1
            Exit Function
        End If
    Else
        Chkgrd = -1
        Exit Function
    End If
End With

End With
Chkgrd = 1
End Function

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyRight Then keybd_event 9, 0, 0, 0
    If KeyCode = vbKeyLeft Then
        keybd_event 9, 1, 1, 0
            End If
End Sub