frmautowaste.frm

一个功能比较完善的远程抄表软件

'On Error GoTo ProcError
    Dim rcUserData As Recordset
    Dim strUserID As String
    Dim num As Integer
    Dim SQL As String
    Dim rclastSum As Recordset
    Dim DevType As Integer
    Dim curQuan As Single
   
    Set rcUserData = dbCbb.OpenRecordset("userData", dbOpenDynaset)
    
    strUserID = Trim(lstSumDev.Text)
    num = InStr(strUserID, "/")
    If Len(strUserID) > 0 Then
        strUserID = Left$(strUserID, num - 1)
    End If
    If Not IsDate(cmbDate1.List(cmbDate1.ListIndex)) Then
        Exit Sub
    End If
        
    rcDevsMap.FindFirst "Name =""" + Format(cmbDevName.Text) + """"
    If Not rcDevsMap.NoMatch Then
        DevType = rcDevsMap!TypeID
        If IsNull(rcDevsMap!Quan) Then
            curQuan = 1
            rcDevsMap.Edit
            rcDevsMap!Quan = 1
            rcDevsMap.Update
        Else
            curQuan = rcDevsMap!Quan
        End If
    Else
        curQuan = 1
    End If

    rcUserDev.FindFirst "UserID=" + Format(strUserID) & "And DevType =" + Format(DevType)
    If rcUserDev.NoMatch Then
        MsgBox "当前用户没有" & Trim(cmbDevName.Text), 64, "用户损耗"
        Exit Sub
    End If
    
    SQL = "select * from UserData "
    SQL = SQL + "where UserID=" + Format(strUserID) + " "
    SQL = SQL + "and DevID=" + Format(Val(cmbDevName.ListIndex) + 2) + " "
    SQL = SQL + "and format(Date,""yyyy/mm/dd"")=""" + Format((cmbDate1.Text), "yyyy/mm/dd") + """"
    Set rclastSum = dbCbb.OpenRecordset(SQL)
    If rclastSum.RecordCount > 0 Then
        rclastSum.MoveFirst
        Do While Not rclastSum.EOF
            lblLastSum.Caption = " " & Format(Val(rclastSum!Value) * curQuan, "######0.0")
            rclastSum.MoveNext
        Loop
    Else
        MsgBox "当前选择的总表在" & Trim(cmbDate1.Text) & "没有有效数据！", 64, "用户损耗"
    End If
    rclastSum.Close
    rcUserData.Close
    Exit Sub
ProcError:
    ProcErr
End Sub

Private Sub cmdDateSum2_Click()
'On Error GoTo ProcError
    Dim rcUserData As Recordset
    Dim strUserID As String
    Dim num As Integer
    Dim SQL As String
    Dim rcNowSum As Recordset
    Dim DevType As Integer
    Dim curQuan As Single
    
    Set rcUserData = dbCbb.OpenRecordset("userData", dbOpenDynaset)
    
    strUserID = Trim(lstSumDev.Text)
    num = InStr(strUserID, "/")
    If Len(strUserID) > 0 Then
        strUserID = Left$(strUserID, num - 1)
    End If
    If Not IsDate(cmbDate2.List(cmbDate2.ListIndex)) Then
        Exit Sub
    End If
            
    rcDevsMap.FindFirst "Name =""" + Format(cmbDevName.Text) + """"
    If Not rcDevsMap.NoMatch Then
        DevType = rcDevsMap!TypeID
        If IsNull(rcDevsMap!Quan) Then
            curQuan = 1
            rcDevsMap.Edit
            rcDevsMap!Quan = 1
            rcDevsMap.Update
        Else
            curQuan = rcDevsMap!Quan
        End If
    Else
        curQuan = 1
    End If
    
    rcUserDev.FindFirst "UserID=" + Format(strUserID) & "And DevType =" + Format(DevType)
    If rcUserDev.NoMatch Then
        MsgBox "当前用户没有" & Trim(cmbDevName.Text), 64, "用户损耗"
        Exit Sub
    End If
    
    SQL = "select * from UserData "
    SQL = SQL + "where UserID=" + Format(strUserID) + " "
    SQL = SQL + "and DevID=" + Format(Val(cmbDevName.ListIndex) + 2) + " "
    SQL = SQL + "and format(Date,""yyyy/mm/dd"")=""" + Format((cmbDate2.Text), "yyyy/mm/dd") + """"
    Set rcNowSum = dbCbb.OpenRecordset(SQL)
    If rcNowSum.RecordCount > 0 Then
        rcNowSum.MoveFirst
        Do While Not rcNowSum.EOF
            lblNowSum.Caption = " " & Format(Val(rcNowSum!Value) * curQuan, "######0.0")
            rcNowSum.MoveNext
        Loop
    Else
        MsgBox "当前选择的总表在" & Trim(cmbDate2.Text) & "没有有效数据！", 64, "用户损耗"
    End If
    rcNowSum.Close
    rcUserData.Close
    Exit Sub
ProcError:
    ProcErr
End Sub

Private Sub cmdWrite_Click()
'On Error GoTo ProcError
    Dim SQL As String
    Dim curSelUser As String
    Dim rcWrite As Recordset
    Dim rcWaste As Recordset
    Dim DoorStar As Integer
    Dim DoorEnd As Integer
    Dim DateLater As Date
    Dim DateFormer As Date
    Dim i As Integer
    Dim CurVal As Single
    
    Set rcUserDev = dbCbb.OpenRecordset("UserDev", dbOpenDynaset)
    Set rcWaste = dbCbb.OpenRecordset("waste", 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 lstSumDev.SelCount > 0 Then
        For i = 0 To lstSumDev.ListCount - 1
            If lstSumDev.Selected(i) Then
                SQL = "select * from UserMap "
                SQL = SQL + "where " + CondStr
                SQL = SQL + " and trim(UserName)<>""总表"""
                Set rcSumDev = dbCbb.OpenRecordset(SQL)
                If rcSumDev.RecordCount > i Then
                    rcSumDev.AbsolutePosition = i
                    rcWaste.FindFirst "DevID=" + Format(cmbDevName.ListIndex + 2) _
                    & " and UserID=" + Format(rcSumDev!UserID) _
                    & " and format(Date1,""yyyy-mm-dd"")=""" _
                    & Format(DateLater, "yyyy-mm-dd") + """" _
                    & " and format(Date2,""yyyy-mm-dd"")=""" _
                    & Format(DateFormer, "yyyy-mm-dd") + """" _
                    
                    If MsgBox("确定所填写的损耗量吗？", 4 + 32, "用户损耗") = vbNo Then
                        Exit Sub
                    End If
                    If rcWaste.NoMatch Then
                        rcUserDev.FindFirst "UserID=" + Format(rcSumDev!UserID)
                        Do While Not rcUserDev.NoMatch
                            rcWaste.AddNew
                            rcWaste!UserID = rcSumDev!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(lblAverageWst.Caption, "###########.0")
                                CurVal = Val(rcWaste!Value) + Val(rcUserDev.CurVal)
                                UpdateUserFee rcWaste!UserID, rcUserDev!DevType, CurVal
                            End If
                            rcWaste.Update
                            rcUserDev.FindNext "UserID=" + Format(rcSumDev!UserID)
                        Loop
                    Else
                        If MsgBox("当前用户的" & cmbDevName.Text & "损耗量为" & rcWaste!Value & "，" & Chr(10) & "是否替换已有的数据？", 4 + 32, "用户损耗") = vbNo Then
                            Exit Sub
                        End If
                        rcUserDev.FindFirst "DevID=" + Format(cmbDevName.ListIndex + 2) _
                        & " and UserID=" + Format(rcSumDev!UserID)
                        If Not rcUserDev.NoMatch Then
                            CurVal = Val(rcWaste!Value) - Val(lblAverageWst.Caption) + Val(rcUserDev.CurVal)
                            UpdateUserFee rcWaste!UserID, rcUserDev!DevType, CurVal
                            rcWaste.Edit
                            rcWaste!Value = Format(lblAverageWst.Caption, "##########.0")
                            rcWaste.Update
                        End If
                    End If
                End If
            End If
        Next i
    End If
    Exit Sub
ProcError:
    ProcErr
End Sub


Private Sub Form_Load()
'On Error GoTo ProcError
    If UBound(curForm) > 0 Then
        curForm(UBound(curForm)).Enabled = False
    End If
    ReDim Preserve curForm(UBound(curForm) + 1)
    Set curForm(UBound(curForm)) = Me
  
    
    Set rcDevsMap = dbCbb.OpenRecordset("DevsMap", dbOpenDynaset)
    Set rcUserDev = dbCbb.OpenRecordset("UserDev", dbOpenDynaset)
    
    fillDate
    fillDevName
    fillBuild
    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
Public Sub fillDevName()
Dim rcFillDev As Recordset
    Dim SQL As String
    SQL = "select * from DevsMap "
    SQL = SQL + "where name<>""地址"""
    Set rcFillDev = dbCbb.OpenRecordset(SQL, dbOpenDynaset)
    If rcFillDev.RecordCount > 0 Then
        rcFillDev.MoveFirst
        Do While Not rcFillDev.EOF
            cmbDevName.AddItem rcFillDev!Name
            rcFillDev.MoveNext
        Loop
    End If
    rcFillDev.Close
    If cmbDevName.ListCount > 0 Then
        cmbDevName.Text = cmbDevName.List(0)
    End If
End Sub

Public Sub fillBuild()
    Dim rcBuildMap As Recordset
    Set rcBuildMap = dbCbb.OpenRecordset("BuildMap", dbOpenDynaset)
    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
End Sub

Private Sub filllstUserDev()
    Dim SQL As String
 
    
    SQL = "select * from UserMap "
    SQL = SQL + "where trim(UserName)=""总表"" and BuildID=""" + cmbBuild.Text + """"
    Set rcSumDev = dbCbb.OpenRecordset(SQL)
    If rcSumDev.RecordCount > 0 Then
        Do While Not rcSumDev.EOF
            If Not Val(rcSumDev!Unit) > 0 Then
                lstSumDev.AddItem rcSumDev!UserID & "/" & Trim(rcSumDev!Address)
            Else
                lstSumDev.AddItem rcSumDev!UserID & "/" & Trim(rcSumDev!Unit) & "单元/" & Trim(rcSumDev!Address)
            End If
            rcSumDev.MoveNext
        Loop
    End If
    rcSumDev.Close
End Sub

Public Sub ClearLbl()
    lblLastSum.Caption = ""
    lblNowSum.Caption = ""
    lblAverageWst.Caption = ""
End Sub

Private Sub lstSumDev_Click()
    ClearLbl
End Sub