frmdatainput1.frm

来自「水电费收费管理系统」· FRM 代码 · 共 654 行 · 第 1/2 页

    strsql = strsql & Mid(Trim(frmfeeinput.txtfields(2).Text), 1, InStr(1, Trim(frmfeeinput.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 DTPicker1_Change()
 
                
                 
                 filldata VAL(txtfields(0).Text)
                 filldata1 VAL(txtfields(0).Text)
End Sub

Private Sub Form_Load()
Show


 DTPicker1 = DateSerial(Year(Date), Month(Date), 1)
 DTPicker2 = DateSerial(Year(Date), Month(Date), 1)
  txtfields(3).SelStart = 0
                txtfields(3).SelLength = Len(txtfields(3))
                txtfields(3).SetFocus
                
                 fillname Trim(frmfeeinput.txtfields(2).Text)
                 filldata VAL(frmfeeinput.txtfields(0).Text)
                 filldata1 VAL(frmfeeinput.txtfields(0).Text)
End Sub


Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
        Select Case Index
            Case 2
          
                
               
            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) = "0"
    txtfields(7) = "0"
    txtfields(8) = "0"
   
    
    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) = "0"
    txtfields(4) = "0"
    txtfields(5) = "0"

  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