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

📄 frm_交费登记.frm

📁 农村水电费记帐录入
💻 FRM
📖 第 1 页 / 共 2 页
字号:
End If
Start False
End Sub

Private Sub CmdEsc_Click()
    Start True
End Sub

Private Sub Cmdexit_Click()
    Unload Me
End Sub

Private Sub cmdsave_Click()
Dim rsDianrec As New ADODB.Recordset
Dim rsgx As New ADODB.Recordset
Dim RevRecNo As String
Dim RevRecNoi As Integer
Dim strcls As String
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 rsDianrec
 If .State = adStateOpen Then .Close
 .Open "select top 0 * from 交费记录 ", strcnn, adOpenKeyset, adLockBatchOptimistic
End With

With grdmain
    For i = 1 To grdmainlns
            With rsDianrec   'ws产品接收记录表
                .AddNew
                .Fields("用户编号") = Trim(grdmain.TextMatrix(i, 1))
                .Fields("月份") = Format(DtpOut.Value, "yymm")
                .Fields("交费金额") = Trim(grdmain.TextMatrix(i, 3))
                If Trim(grdmain.TextMatrix(i, 10)) <> "" Then .Fields("备注") = Trim(grdmain.TextMatrix(i, 10))
                .Fields("录入人") = Trim(frmlogin.InOp)
                .Fields("交费日期") = Format(Now(), "yyyy-mm-dd")
                .Fields("记录类型") = 0
            End With
    Next i
End With
strcnn.BeginTrans
    rsDianrec.UpdateBatch
strcnn.CommitTrans
rsDianrec.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, 1000, 800, 800, 800, 1000, 1600, 0)
coltype = Array(0, 3, 3, 2, 2, 2, 2, 2, 2, 2, 0, 2)
collock = Array(1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1)
With AdoID
    .ConnectionString = strcnn
    .RecordSource = "SELECT 用户编号, 姓名, 欠款 AS 应交金额,上月欠费,  本月电量 AS 用电量, 本月电费 AS 电费, 本月水费  " & _
      " AS 水费,  本月水电费 AS 水电费, selcol ,欠费登记 FROM f_sdfcount('" & Trim(Format(DtpOut.Value, "yymm")) & "')  where cast(本月电量 as float) >0 and cast(本月交费 as float)=0  order by 用户编号"
    
    Debug.Print .RecordSource
    .Refresh
End With
With Adoname
    .ConnectionString = strcnn
    .RecordSource = "SELECT 用户编号, 姓名, 欠款 AS 应交金额,上月欠费, 本月电量 AS 用电量, 本月电费 AS 电费, 本月水费  " & _
      " AS 水费,  本月水电费 AS 水电费, selcol,欠费登记  FROM f_sdfcount('" & Trim(Format(DtpOut.Value, "yymm")) & "')  where cast(本月电量 as float) >0 and cast(本月交费 as float) =0 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) = 8
    .ShowListHeader(2) = True
    .ListWidth(2) = 7200
    .ListRows(2) = 10
    .ListSearchMode(2) = LinearSearch
    .ListAutoFind(2) = True
    .Editable = True
    .ListColWidth(2, 1) = 800 '姓名
    .ListColWidth(2, 0) = 800 '用户编号
    .ListColWidth(2, 2) = 800 '应交金额
    .ListColWidth(2, 3) = 800 '上月欠款
    .ListColWidth(2, 4) = 800 '电量
    .ListColWidth(2, 5) = 800 '电费
    .ListColWidth(2, 6) = 800 '水费
    .ListColWidth(2, 7) = 800 '水电费
    .ListColWidth(2, 8) = 0 'selcol
    .ListColWidth(2, 9) = 600 '欠费登记

    .ListColAlignment(2, 0) = flexAlignLeftCenter
    .ListColAlignment(2, 1) = flexAlignLeftCenter
    .ListColAlignment(2, 2) = flexAlignCenterCenter
    .ListColAlignment(2, 3) = flexAlignCenterCenter
    .ListColAlignment(2, 4) = flexAlignCenterCenter
    .ListColAlignment(2, 5) = flexAlignCenterCenter
    .ListColAlignment(2, 6) = flexAlignCenterCenter
    .ListColAlignment(2, 7) = flexAlignCenterCenter
    .ListColResize(2) = True
    

    
    Set .ListDataSource(1) = AdoID
    .ListSelectCol(1) = 0
    .ShowListHeader(1) = True
    .ListWidth(1) = 7200
    .ListRows(1) = 10
    .ListSearchMode(1) = LinearSearch
    .ListAutoFind(1) = True
    .Editable = True
    .ListColWidth(1, 1) = 800 '姓名
    .ListColWidth(1, 0) = 800 '用户编号
    .ListColWidth(1, 2) = 800 '应交金额
    .ListColWidth(1, 3) = 800 '上月欠款
    .ListColWidth(1, 4) = 800 '电量
    .ListColWidth(1, 5) = 800 '电费
    .ListColWidth(1, 6) = 800 '水费
    .ListColWidth(1, 7) = 800 '水电费
    .ListColWidth(1, 8) = 0 ''selcol
    .ListColWidth(1, 9) = 600 '欠费登记
    .ListColAlignment(1, 0) = flexAlignLeftCenter
    .ListColAlignment(1, 1) = flexAlignLeftCenter
    .ListColAlignment(1, 2) = flexAlignCenterCenter
    .ListColAlignment(1, 3) = flexAlignCenterCenter
    .ListColAlignment(1, 4) = flexAlignCenterCenter
    .ListColAlignment(1, 5) = flexAlignCenterCenter
    .ListColAlignment(1, 6) = flexAlignCenterCenter
    .ListColAlignment(1, 7) = 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 = 2 Or .Col = 1 Then
       a = Split(Value, Chr(9))
        If Not Trim(a(9)) Then
            MsgBox "请先录入用户期初数,再登记本月交费!", , "系统提示"
            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, 4) = Trim(a(2))    '应交
        If Trim(a(3)) <> "" Then .TextMatrix(Row, 5) = Trim(a(3)) '上月欠款
        If Trim(a(4)) <> "" Then .TextMatrix(Row, 6) = Trim(a(4)) '电量
        If Trim(a(5)) <> "" Then .TextMatrix(Row, 7) = Trim(a(5)) '电费
        If Trim(a(6)) <> "" Then .TextMatrix(Row, 8) = Trim(a(6)) '水费
        If Trim(a(7)) <> "" Then .TextMatrix(Row, 9) = Trim(a(7)) '水电费
        .TextMatrix(Row, 11) = a(9) '欠费登记
    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
    .Rows = 1
    .Rows = 2
    .FixedRows = 1
    .FixedCols = 1
    grdmainlns = 1
    .Editable = Not isCanUse
    If isCanUse Then
        .Col = 1
        .TextMatrix(1, 0) = "001"
    End If
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
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)) = "" Or Val(Trim(.TextMatrix(rowi, 3))) <= 0 Then '实交金额
    Chkgrd = -3
    Exit Function
End If

If .TextMatrix(rowi, 11) <> "True" Then '欠费登记
    For i = 1 To .Cols - 1
        .TextMatrix(rowi, i) = ""
    Next i
    Chkgrd = -1
    Exit Function
End If

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

⌨️ 快捷键说明

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