📄 frmcopypanel.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{E95A2510-F3D1-416D-823B-4F840FE98091}#3.0#0"; "Command.ocx"
Begin VB.Form frmCopyP
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Dialog
Caption = "用户抄表"
ClientHeight = 5265
ClientLeft = 45
ClientTop = 330
ClientWidth = 4920
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5265
ScaleWidth = 4920
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin CSCommand.Command Command2
Height = 375
Left = 2280
TabIndex = 2
Top = 4680
Width = 975
_ExtentX = 1720
_ExtentY = 661
IconAlign = 0
Icon = "FrmcopyPanel.frx":0000
Caption = "确定"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin CSCommand.Command Command1
Height = 375
Left = 480
TabIndex = 1
Top = 4680
Width = 975
_ExtentX = 1720
_ExtentY = 661
IconAlign = 0
Icon = "FrmcopyPanel.frx":001C
Caption = "返回"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.CommandButton cmdAsure
Caption = "确定添加"
Height = 495
Left = 1440
TabIndex = 0
Top = 6000
Width = 855
End
Begin VB.Frame Frame1
BackColor = &H00C0C0C0&
Caption = "用户抄表"
Height = 3975
Left = 135
TabIndex = 3
Top = 600
Width = 4575
Begin VB.TextBox txtUserName
Appearance = 0 'Flat
Height = 375
Index = 2
Left = 2160
TabIndex = 7
Top = 1305
Width = 1695
End
Begin VB.TextBox txtUserName
Appearance = 0 'Flat
Height = 375
Index = 1
Left = 2160
TabIndex = 6
Top = 765
Width = 1695
End
Begin VB.TextBox txtUserName
Appearance = 0 'Flat
DataSource = "AdoC"
Height = 375
Index = 0
Left = 2160
TabIndex = 5
Top = 240
Width = 1695
End
Begin VB.TextBox txtUserName
Appearance = 0 'Flat
Height = 375
Index = 9
Left = 2160
TabIndex = 4
Top = 2520
Width = 1695
End
Begin MSComCtl2.DTPicker dtpwdate
Height = 375
Index = 0
Left = 2160
TabIndex = 8
Top = 1920
Width = 1695
_ExtentX = 2990
_ExtentY = 661
_Version = 393216
Format = 24838145
CurrentDate = 38393
End
Begin MSComCtl2.DTPicker dtpwdate
Height = 375
Index = 1
Left = 2160
TabIndex = 9
Top = 3120
Width = 1695
_ExtentX = 2990
_ExtentY = 661
_Version = 393216
Format = 24838145
CurrentDate = 38393
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "抄表日期"
Height = 255
Index = 1
Left = 480
TabIndex = 15
Top = 1920
Width = 1095
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "上次至码"
Height = 255
Left = 480
TabIndex = 14
Top = 1320
Width = 1095
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "用户编号"
Height = 255
Index = 0
Left = 480
TabIndex = 13
Top = 360
Width = 1095
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "用户姓名"
Height = 255
Left = 480
TabIndex = 12
Top = 840
Width = 1095
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "当前至码"
Height = 255
Left = 480
TabIndex = 11
Top = 2520
Width = 1095
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "抄录日期"
Height = 255
Index = 7
Left = 480
TabIndex = 10
Top = 3120
Width = 1095
End
End
Begin VB.PictureBox Picture1
BackColor = &H00C0C000&
BorderStyle = 0 'None
Height = 615
Left = 0
Picture = "FrmcopyPanel.frx":0038
ScaleHeight = 615
ScaleWidth = 5295
TabIndex = 16
Top = 0
Width = 5295
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "单户抄表"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 285
Left = 1440
TabIndex = 17
Top = 120
Width = 1200
End
End
End
Attribute VB_Name = "frmCopyP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim buttontime As Boolean
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command2_Click()
Dim cnn As New ADODB.Connection
Dim rstE As New ADODB.Recordset
Dim cmdExe As New ADODB.Command
Dim nowEv As Double
Dim sqlAdd As String
If Trim(txtUserName(0).Text) = "" Then
MsgBox " 没有要抄表用户，请先添加用户！ ", vbInformation
Exit Sub
End If
If Trim(txtUserName(9).Text) = "" Then
MsgBox " 请先输入数据！ ", vbInformation
Exit Sub
End If
If Trim(txtUserName(9).Text) < Trim(txtUserName(2).Text) Then
MsgBox " 输入数据错误，当前止码太小！ ", vbInformation
Exit Sub
End If
cnn.ConnectionString = cnn
cnn.CursorLocation = adUseClient
cnn.Open
cmdExe.ActiveConnection = cnn
rstE.Open "select nowecount from v_水电费记录 where 姓名ID= '" & Trim(txtUserName(0)) & "'", cnn, adOpenStatic, adLockBatchOptimistic
nowEv = Val(rstE.Fields(0).Value) + (Val(txtUserName(9)) - Val(txtUserName(2)))
sqlAdd = "update v_水电费记录 set LEndPCode=" & Val(txtUserName(2).Text) & ",cEndCode=" & Val(txtUserName(9).Text) & ",nowEcount=" & nowEv & " ,writedate=#" & dtpWdate(1) & "# where 姓名ID= '" & Trim(txtUserName(0)) & "'"
cmdExe.CommandText = sqlAdd
cmdExe.Execute sqlAdd
' cnn.Execute sqlAdd
txtUserName(2).Text = txtUserName(9)
txtUserName(9) = ""
cnn.Close
MsgBox " 数据保存完成！ ", vbInformation
Unload Me
End Sub
Private Sub Form_Load()
Dim rst As New ADODB.Recordset
Dim sqlEdit As String
dtpWdate(1).Value = Format(Now, "yyyy-mm-dd")
sqlEdit = "select * from v_水电费记录 "
sqlEdit = sqlEdit & " where 姓名id='" & Trim(MDIme.txtUserName(0)) & "'and 有效用户<>0"
rst.Open sqlEdit, gCnn, adOpenStatic, adLockBatchOptimistic
If Not rst.EOF Then
txtUserName(0) = rst.Fields(1)
txtUserName(1) = rst.Fields(2)
txtUserName(2) = rst.Fields!cendcode
dtpWdate(0).Value = rst.Fields(4)
End If
buttontime = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
MDIme.loadData (txtUserName(0))
Cancel = 0
End Sub
Private Sub nextuser_Click()
Dim rst As New ADODB.Recordset
Dim sqlEdit As String
sqlEdit = "select * from v_水电费记录 "
sqlEdit = sqlEdit & " where 姓名id<>'" & Trim(txtUserName(0)) & "'and 有效用户<>0 "
rst.Open sqlEdit, gCnn, adOpenStatic, adLockBatchOptimistic
If buttontime = False Then
If Not rst.EOF Then
txtUserName(0) = rst.Fields(1)
txtUserName(1) = rst.Fields(2)
txtUserName(2) = rst.Fields!cendcode
dtpWdate(0).Value = rst.Fields(4)
buttontime = True
End If
Else
rst.MoveNext
If Not rst.EOF Then
txtUserName(0) = rst.Fields(1)
txtUserName(1) = rst.Fields(2)
txtUserName(2) = rst.Fields!cendcode
dtpWdate(0).Value = rst.Fields(4)
buttontime = True
End If
End If
End Sub
Private Sub txtUserName_KeyPress(Index As Integer, KeyAscii As Integer)
If Index = 9 Then
If KeyAscii <> 8 And KeyAscii <> 46 And KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -