📄 frmmanualwaste.frm
字号:
VERSION 5.00
Begin VB.Form frmManualWaste
BorderStyle = 1 'Fixed Single
Caption = "手工录入的损耗"
ClientHeight = 3480
ClientLeft = 45
ClientTop = 330
ClientWidth = 5760
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3480
ScaleWidth = 5760
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "返回"
Height = 390
Left = 4365
TabIndex = 10
Top = 3000
Width = 1230
End
Begin VB.ComboBox cmbDevName
Height = 300
Left = 825
Style = 2 'Dropdown List
TabIndex = 9
Top = 1050
Width = 1755
End
Begin VB.TextBox txtWaste
Height = 330
Left = 3900
TabIndex = 8
Top = 1950
Width = 1485
End
Begin VB.CommandButton cmdWrite
Caption = "写入"
Height = 390
Left = 2940
TabIndex = 7
Top = 3000
Width = 1230
End
Begin VB.Frame Frame1
Caption = "选择日期:"
Height = 795
Left = 120
TabIndex = 2
Top = 120
Width = 5520
Begin VB.ComboBox cmbDate2
Height = 300
Left = 3510
Style = 2 'Dropdown List
TabIndex = 4
Top = 300
Width = 1710
End
Begin VB.ComboBox cmbDate1
Height = 300
Left = 960
Style = 2 'Dropdown List
TabIndex = 3
Top = 300
Width = 1710
End
Begin VB.Label Label2
Caption = "到"
Height = 285
Left = 3015
TabIndex = 6
Top = 360
Width = 210
End
Begin VB.Label Label1
Caption = "从"
Height = 240
Left = 495
TabIndex = 5
Top = 330
Width = 210
End
End
Begin VB.ComboBox cmbBuild
Height = 300
Left = 825
Style = 2 'Dropdown List
TabIndex = 1
Top = 1500
Width = 1755
End
Begin VB.ListBox lstUser
Height = 1500
Left = 840
MultiSelect = 2 'Extended
TabIndex = 0
Top = 1860
Width = 1740
End
Begin VB.Label Label5
Caption = "表类型:"
Height = 285
Left = 150
TabIndex = 14
Top = 1095
Width = 645
End
Begin VB.Label Label4
Caption = "损耗量:"
Height = 285
Left = 3105
TabIndex = 13
Top = 2010
Width = 690
End
Begin VB.Label Label6
Caption = "楼:"
Height = 285
Left = 510
TabIndex = 12
Top = 1545
Width = 285
End
Begin VB.Label Label8
Caption = "门牌:"
Height = 330
Left = 315
TabIndex = 11
Top = 1875
Width = 465
End
End
Attribute VB_Name = "frmManualWaste"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/07/09
'描 述：CBB三表户外计量系统 Ver 5.2
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Dim rcTemUserMap As Recordset
Private Sub cmbBuild_Click()
On Error GoTo ProcError
Dim temUserStr As String
Dim curDoor As String
Dim curUnit As String
Dim curFloor As String
Dim curName As String
Dim curAddr As String
lstUser.Clear
SQL = "select * from UserMap "
SQL = SQL + "where BuildID=""" + Trim(cmbBuild.List(cmbBuild.ListIndex)) + """ "
SQL = SQL + "and trim(UserName)<>""总表"" "
SQL = SQL + "order by val(UserID) ASC,val(Unit) ASC,val(Floor) ASC,val(Door) ASC "
Set rcTemUserMap = dbCbb.OpenRecordset(SQL)
Do While Not rcTemUserMap.EOF
If IsNull(curUnit) Then
curUnit = ""
Else
curUnit = Trim(rcTemUserMap!Unit)
End If
If IsNull(rcTemUserMap!Floor) Then
curFloor = ""
Else
curFloor = Trim(rcTemUserMap!Floor)
End If
If IsNull(rcTemUserMap!Door) Then
curDoor = ""
Else
curDoor = Trim(rcTemUserMap!Door)
End If
If IsNull(rcTemUserMap!userName) Then
curName = ""
Else
curName = Trim(rcTemUserMap!userName)
End If
temUserStr = curUnit + "单元/" + curFloor + "层/" + curDoor + "号/" + curName
lstUser.AddItem temUserStr
rcTemUserMap.MoveNext
Loop
If Not (rcTemUserMap.RecordCount > 0) Then
Exit Sub
End If
Exit Sub
ProcError:
ProcErr
End Sub
Private Sub cmdCancel_Click()
Unload Me
Set frmWaste = Nothing
End Sub
Private Sub cmdWrite_Click()
'On Error GoTo ProcError
Dim SQL As String
Dim curSelUser As String
Dim rcWaste As Recordset
Dim CondStr As String
Dim DoorStar As Integer
Dim DoorEnd As Integer
Dim DateLater As Date
Dim DateFormer As Date
Dim rcDevsMap As Recordset
Set rcUserDev = dbCbb.OpenRecordset("UserDev", dbOpenDynaset)
Set rcWaste = dbCbb.OpenRecordset("waste", dbOpenDynaset)
Set rcDevsMap = dbCbb.OpenRecordset("DevsMap", dbOpenDynaset)
If Not IsDate(cmbDate1.List(cmbDate1.ListIndex)) And Not IsDate(cmbDate2.List(cmbDate1.ListIndex)) Then
Exit Sub
End If
If IsDate(cmbDate1.List(cmbDate1.ListIndex)) Then
QDate1 = CDate(cmbDate1.List(cmbDate1.ListIndex))
Else
QDate1 = 0
End If
If IsDate(cmbDate2.List(cmbDate2.ListIndex)) Then
QDate2 = CDate(cmbDate2.List(cmbDate2.ListIndex))
Else
QDate2 = 0
End If
If QDate1 = 0 And QDate2 = 0 Then
MsgBox "请选择有效的数据日期", 48, "用户损耗"
Exit Sub
End If
DateLater = IIf(QDate1 >= QDate2, QDate1, QDate2)
DateFormer = IIf(QDate1 = QDate2, 0, IIf(QDate1 < QDate2, QDate1, QDate2))
If lstUser.SelCount > 0 Then
For i = 0 To lstUser.ListCount - 1
If lstUser.Selected(i) Then
rcTemUserMap.AbsolutePosition = i
rcDevsMap.FindFirst "Name =""" + Format(cmbDevName.Text) + """"
If Not rcDevsMap.NoMatch Then
rcUserDev.FindFirst "UserID=" + Format(rcTemUserMap!UserID) + "and DevType=" + Format(rcDevsMap!TypeID)
If rcUserDev.NoMatch Then
MsgBox "当前用户没有" & Trim(cmbDevName.Text), 64, "用户损耗"
Exit Sub
End If
End If
If Not IsNumeric(txtWaste.Text) Or IsNull(txtWaste.Text) Or Trim(txtWaste.Text) = "" Then
MsgBox "请输入有效的用户损耗量", 48, "用户损耗"
Exit Sub
End If
If MsgBox("确定所填写的损耗量吗？", 4 + 32, "用户损耗") = vbNo Then
Exit Sub
End If
rcWaste.FindFirst "UserID=" + Format(rcTemUserMap!UserID) _
& "and DevID =" + Format(Val(cmbDevName.ListIndex) + 2) _
& " and format(Date1,""yyyy-mm-dd"")=""" _
& Format(DateLater, "yyyy-mm-dd") + """" _
& " and format(Date2,""yyyy-mm-dd"")=""" _
& Format(DateFormer, "yyyy-mm-dd") & """"
If rcWaste.NoMatch Then
rcUserDev.FindFirst "UserID=" + Format(rcTemUserMap!UserID)
Do While Not rcUserDev.NoMatch
rcWaste.AddNew
rcWaste!UserID = rcTemUserMap!UserID
rcWaste!devID = Format(rcUserDev.devID)
rcWaste!Date1 = DateLater
rcWaste!Date2 = DateFormer
If rcUserDev.devID <> Val(cmbDevName.ListIndex) + 2 Then
rcWaste!Value = 0
Else
rcWaste!Value = Format(txtWaste.Text, "###########.0")
CurVal = Val(txtWaste.Text) + Val(rcUserDev!CurVal)
UpdateUserFee rcWaste!UserID, rcUserDev!DevType, CurVal
End If
rcWaste.Update
rcUserDev.FindNext "UserID=" + Format(rcTemUserMap!UserID)
Loop
Else
If MsgBox("当前用户的" & cmbDevName.Text & "损耗量为" & rcWaste!Value & "，" & Chr(10) & "是否替换已有的数据？", 4 + 32, "用户损耗") = vbNo Then
Exit Sub
End If
rcUserDev.FindFirst "UserID=" + Format(rcTemUserMap!UserID) _
& "and DevID =" + Format(Val(cmbDevName.ListIndex) + 2)
If Not rcUserDev.NoMatch Then
CurVal = Val(txtWaste.Text) - Val(rcWaste!Value) + Val(rcUserDev!CurVal)
UpdateUserFee rcWaste!UserID, rcUserDev!DevType, CurVal
rcWaste.Edit
rcWaste!Value = Format(txtWaste.Text, "##########.0")
rcWaste.Update
End If
End If
DoEvents
End If
Next i
Else
MsgBox "请选择需要录入损耗的用户！", 48, "用户损耗"
End If
rcWaste.Close
rcUserDev.Close
rcDevsMap.Close
Exit Sub
ProcError:
ProcErr
End Sub
Private Sub Form_Load()
'On Error GoTo ProcError
Dim SQL As String
If UBound(curForm) > 0 Then
curForm(UBound(curForm)).Enabled = False
End If
ReDim Preserve curForm(UBound(curForm) + 1)
Set curForm(UBound(curForm)) = Me
Dim rcDate As Recordset
Dim rcDevsMap As Recordset
Dim rcBuildMap As Recordset
Dim rcUnit As Recordset
cmbDate1.Clear
cmbDate2.Clear
SQL = "select distinct format(date,""yyyy-mm-dd"") as sDate "
SQL = SQL + "from userdata"
Set rcDate = dbCbb.OpenRecordset(SQL)
Do While Not rcDate.EOF
cmbDate1.AddItem rcDate!sDate
cmbDate2.AddItem rcDate!sDate
rcDate.MoveNext
Loop
rcDate.Close
cmbDate1.AddItem "" '添加一个空项,以可选则空日期(即不选)
cmbDate2.AddItem ""
cmbDevName.Clear
SQL = "select name from DevsMap where Name<>""地址"""
Set rcDevsMap = dbCbb.OpenRecordset(SQL, dbOpenDynaset)
If rcDevsMap.RecordCount > 0 Then
rcDevsMap.MoveFirst
Do While Not rcDevsMap.EOF
cmbDevName.AddItem rcDevsMap!Name
rcDevsMap.MoveNext
Loop
End If
rcDevsMap.Close
If cmbDevName.ListCount > 0 Then
cmbDevName.Text = cmbDevName.List(0)
End If
cmbBuild.Clear
SQL = "select BuildID from BuildMap order by FrameID ASC,BuildID ASC "
Set rcBuildMap = dbCbb.OpenRecordset(SQL)
Do While Not rcBuildMap.EOF
cmbBuild.AddItem Trim(rcBuildMap!BuildID)
rcBuildMap.MoveNext
Loop
rcBuildMap.Close
If cmbBuild.ListCount > 0 Then
cmbBuild.Text = cmbBuild.List(0)
End If
DoEvents
Exit Sub
ProcError:
ProcErr
End Sub
Private Sub Form_Unload(Cancel As Integer)
ReDim Preserve curForm(UBound(curForm) - 1)
If UBound(curForm) > 0 Then
curForm(UBound(curForm)).Enabled = True
End If
End Sub
Private Sub lstUser_Click()
txtWaste.Text = ""
End Sub
Private Sub txtWaste_GotFocus()
txtWaste.SetFocus
txtWaste.SelStart = 0
txtWaste.SelLength = Len(txtWaste.Text)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -