frmdatainput.frm

水电费收费管理系统

      TabIndex        =   8
      Top             =   1800
      Width           =   1500
   End
End
Attribute VB_Name = "frmdatainput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim stoalfee As Single
Private Sub Comdata_Click()
Dim MYSET As New ADODB.Recordset
Dim myset1 As New ADODB.Recordset

If txtfields(2) = "" Then
MsgBox "请输入楼号", vbOKOnly + vbInformation
Exit Sub
Else

 If CHECSTR(txtfields(2).Text) = False Then
          MsgBox "用户号添入格式不对", vbOKOnly + vbInformation
           Exit Sub
           End If
           
For I = 3 To 5
 FILLNULL txtfields(I)
  If chcdata(txtfields(I).Text) = False Then
           GoTo e:
           End If
If txtfields(I).Text = " " Then
txtfields(I).Text = 0
End If

Next

  
If txtfields(1).Text = "" Then
 fillname Trim(txtfields(2).Text)
 End If

strsql = "select * from datawork where huhao='" & _
         Trim(txtfields(2).Text) & _
       "' and clloyear=" & DTPicker1.Year & " and cllomonth=" & _
                           DTPicker1.Month
    MYSET.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
                    
    If MYSET.EOF Then
    strsql = "insert into datawork(louhaoid,USERID1,huhao,name,clloyear,cllomonth,elcmeterfee,elcmeter,watermeterfee,watermeter,watermeter1) values('"
    strsql = strsql & Mid(Trim(txtfields(2).Text), 1, InStr(1, Trim(txtfields(2).Text), "-") - 1) & "号楼'," & Trim(txtfields(0).Text) & ",'" & Trim(txtfields(2).Text) & "','" & Trim(txtfields(1).Text)
    strsql = strsql & "','" & DTPicker1.Year & "','" & DTPicker1.Month & "','" & cmbPrice & "','" & VAL(Trim(txtfields(3).Text)) & "','" & cmbPrice1 & "','" & _
    VAL(Trim(txtfields(4).Text)) & "','" & VAL(Trim(txtfields(5).Text)) & "')"
    On Error Resume Next
    config.cnZdx.Execute strsql
    
     MsgBox " 该用户" & DTPicker1.Year & "年" & DTPicker1.Month & "月数据输入成功！", vbOKOnly + vbInformation
    checkcount
   
    Else
    If MsgBox(" 该用户" & DTPicker1.Year & "年" & DTPicker1.Month & "月数据已经存在，是否修改？", vbYesNo + vbQuestion) = vbYes Then
    strsql = "update datawork set elcmeter=" & VAL(Trim(txtfields(3).Text)) & "," & _
    "watermeter = " & VAL(Trim(txtfields(4).Text)) & ",watermeter1=" & VAL(Trim(txtfields(5).Text)) & " where huhao = '" & Trim(txtfields(2).Text) & "'and clloyear=" & DTPicker1.Year & " and cllomonth=" & _
                           DTPicker1.Month
    On Error Resume Next
    config.cnZdx.Execute strsql
   
    MsgBox " 该用户" & DTPicker1.Year & "年" & DTPicker1.Month & "月数据修改成功！", vbOKOnly + vbInformation
    End If
    
    End If
   End If
   txtfields(2).SetFocus
   Exit Sub
e:   MsgBox "数据格式不对，请检查重新输入", vbOKOnly + vbInformation
  Exit Sub
End Sub





Private Sub Command1_Click()
Unload Me

End Sub



Private Sub Command2_Click()
frmbiao1.Show vbModal
End Sub

Private Sub Form_Load()
Show
txtfields(2).SetFocus

 DTPicker1 = DateSerial(Year(Date), Month(Date), 1)
 DTPicker2 = DateSerial(Year(Date), Month(Date), 1)
End Sub


Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
        Select Case Index
            Case 2
            FILLNULL txtfields(2)
            If CHECSTR(txtfields(2).Text) = False Then
          MsgBox "用户号添入格式不对", vbOKOnly + vbInformation
           Exit Sub
           End If
                
                txtfields(3).SelStart = 0
                txtfields(3).SelLength = Len(txtfields(3))
                txtfields(3).SetFocus
                
                 fillname Trim(txtfields(2).Text)
                 filldata VAL(txtfields(0).Text)
                 filldata1 VAL(txtfields(0).Text)
            Case 3 To 4
               'FILLNULL txtfields(Index)
              If chcdata(txtfields(Index)) = False Then
           MsgBox "数据格式不对，请重新输入", vbOKOnly + vbInformation
           Exit Sub
           End If
              
               txtfields(Index + 1).SelStart = 0
                txtfields(Index + 1).SelLength = Len(txtfields(Index + 1))
                txtfields(Index + 1).SetFocus
             

            Case 5
             'FILLNULL txtfields(Index)
             If chcdata(txtfields(Index)) = False Then
           MsgBox "数据格式不对，请重新输入", vbOKOnly + vbInformation
           Exit Sub
           
           End If
          
             
              Comdata.SetFocus
              
            End Select
            End If
End Sub
Private Sub fillname(STR As String)
Dim MYSET As New ADODB.Recordset

        
strsql = "SELECT * FROM USER1 WHERE HUHAO='" & STR & "'"
MYSET.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
If MYSET.EOF Then
MsgBox "没有此用户，请重新输入正确的楼号", vbOKOnly + vbInformation
Exit Sub
End If
txtfields(1).Text = MYSET("NAME")
txtfields(0).Text = MYSET("USERID1")
cmbPrice.Text = MYSET("ELCMETERFEE")
cmbPrice1.Text = MYSET("WATERMETERFEE")
MYSET.Close
Set MYSET = Nothing


End Sub
Sub changefee()

    Dim MYSET As New ADODB.Recordset
    Dim MyFeeset As New ADODB.Recordset
    Dim MyFeeSet1 As New ADODB.Recordset
    
    Dim stoalfee1 As Single
    Dim stoalfee2 As Single
    
 
    strsql = "select * from user1 where userid1=" & Trim(txtfields(0).Text)
               
    MYSET.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
    If MYSET.EOF Then
    Exit Sub
    End If
  
                    
                    strsql = "select * from datawork where userid1=" & _
                            Trim(txtfields(0).Text) & _
                            " and clloyear=" & _
                            DTPicker1.Year & " and cllomonth=" & _
                            DTPicker1.Month
                    MyFeeset.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
                    
                    If MyFeeset.EOF Then
                     GoTo e:
                      
                    End If
e:                    strsql = "select * from datawork where userid1=" & _
                            Trim(txtfields(0).Text) & _
                            " and  clloyear=" & _
                            IIf(DTPicker1.Month = 1, DTPicker1.Year - 1, DTPicker1.Year) & _
                            " and cllomonth=" & _
                            IIf(DTPicker1.Month = 1, 12, DTPicker1.Month - 1)
                    MyFeeSet1.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
                    If Not MyFeeSet1.EOF Then
                    
                     stoalfee1 = Format((MyFeeset("elcmeter") - MyFeeSet1("elcmeter")) * MYSET("elcmeterfee"), "0.0")
                    stoalfee2 = Format((MyFeeset("watermeter") + MyFeeset("watermeter1") - MyFeeSet1("watermeter") + MyFeeSet1("watermeter1")) * MYSET("watermeterfee"), "0.0")
                    stoalfee = stoalfee1 + stoalfee2
                    Else
                   
                stoalfee = 0
               End If
    
   
        
        MyFeeset.Close
          MyFeeSet1.Close
         MYSET.Close
                   
        myset1.Close
                

        

End Sub

Sub INSERTFEE()
Dim myset1 As New ADODB.Recordset

  strsql = "select * from fee where USERID1=" & Trim(txtfields(0).Text)
        myset1.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
       If myset1.EOF Then
        strsql = "insert into fee values(" & Trim(txtfields(0).Text) & "," & stoalfee & ")"
      config.cnZdx.Execute strsql
     Else
        
        strsql = "update fee set fee=" & stoalfee & " where userid1=" & _
                Trim(txtfields(0).Text)
        config.cnZdx.Execute strsql
        End If
   
End Sub
Sub checkcount()
Dim MYSET As New ADODB.Recordset
Dim myset1 As New ADODB.Recordset
 strsql = "select * from user1 "
        myset1.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
If myset1.EOF Then
Exit Sub
End If

  strsql = "select * from datawork  where clloyear=" & _
                            DTPicker1.Year & " and cllomonth=" & _
                            DTPicker1.Month
    MYSET.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
    If MYSET.EOF Then
    Exit Sub
    End If
    
    If MYSET.RecordCount >= myset1.RecordCount Then
     MsgBox "该月表计数据共" & MYSET.RecordCount & "户输入已全部完成，稍后请执行月费用计算程序", vbOKOnly + vbInformation
    
    End If
                    

End Sub
Sub FILLNULL(str1 As TextBox)

  If str1.Text = "" Then
          str1.Text = "0.0"
           End If

End Sub
Sub filldata(STR2 As Integer)
On Error Resume Next
    Dim MYSET As New ADODB.Recordset
    Dim MyFeeset As New ADODB.Recordset
    
    Dim strsql As String
  
    txtfields(6) = " "
    txtfields(7) = " "
    txtfields(8) = " "
   
    
    Dim MySet2 As Recordset
 DTPicker2 = DTPicker1
  strsql = "select * from user1 where userid1=" & STR2
                strsql = strsql & " order by userid1"
               MYSET.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
                   
                   
          If MYSET.EOF = False Then
                    
e:          MyFeeset.Close
          If DTPicker2.Year < 2003 Then
                Exit Sub
                End If
                 strsql = "select * from datawork where userid1=" & _
                            STR2 & _
                            " and  clloyear=" & _
                            IIf(DTPicker2.Month = 1, DTPicker2.Year - 1, DTPicker2.Year) & _
                            " and cllomonth=" & _
                            IIf(DTPicker2.Month = 1, 12, DTPicker2.Month - 1)
                    MyFeeset.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
                    
                    If MyFeeset.EOF Then
                    DTPicker2.Year = IIf(DTPicker2.Month = 1, DTPicker2.Year - 1, DTPicker2.Year)
                    DTPicker2.Month = IIf(DTPicker2.Month = 1, 12, DTPicker2.Month - 1)
                     GoTo e:
                      
                    End If
                   DTPicker2.Year = IIf(DTPicker2.Month = 1, DTPicker2.Year - 1, DTPicker2.Year)
                    DTPicker2.Month = IIf(DTPicker2.Month = 1, 12, DTPicker2.Month - 1)
                   txtfields(6) = MyFeeset("elcmeter")
                   txtfields(7) = MyFeeset("watermeter")
                   txtfields(8) = MyFeeset("Watermeter1")
                    
                    
                    
                    MyFeeset.Close
                    
                   MYSET.Close
                End If
                
        
End Sub

Sub filldata1(STR2 As Integer)
On Error Resume Next
    Dim MYSET As New ADODB.Recordset
    Dim MyFeeset As New ADODB.Recordset
    
    Dim strsql As String
   txtfields(3) = " "
    txtfields(4) = " "
    txtfields(5) = " "

  strsql = "select * from user1 where userid1=" & STR2
                strsql = strsql & " order by userid1"
               MYSET.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
                   
                   
          If MYSET.EOF = False Then
                    

                 strsql = "select * from datawork where userid1=" & _
                            STR2 & _
                            " and  clloyear=" & _
                            DTPicker1.Year & _
                            " and cllomonth=" & _
                            DTPicker1.Month
                    MyFeeset.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
                    
                    If MyFeeset.EOF Then
                    
                     Exit Sub
                      
                    End If
                   
                   txtfields(3) = MyFeeset("elcmeter")
                   txtfields(4) = MyFeeset("watermeter")
                   txtfields(5) = MyFeeset("Watermeter1")
                    
                    
                    
                    MyFeeset.Close
                    
                   MYSET.Close
                End If
                
        
End Sub