📄 frm_交费登记.frm
字号:
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 + -