frmfeeinput.frm

水电费收费管理系统

 changefee Trim(txtfields(0).Text)
strsql = "select * from userfee where userid1=" & _
                            Trim(txtfields(0)) & _
                            " and clloyear=" & dtpicker1.Year & " and cllomonth=" & _
                            dtpicker1.Month
    myset1.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
    If myset1.EOF Then
   
     strsql = "insert into userfee values('" & Trim(txtfields(0).Text) & "','" & dtpicker1.Year & "','" & dtpicker1.Month & "','" & _
     Date & "','" & VAL(Trim(txtfields(3).Text)) & "','" & Trim(TXTDATA(15).Text) & "')"
     config.cnZdx.Execute strsql
      Else
      txtfields(3).Text = myset1("FEE")
    If MsgBox(" 该户" & dtpicker1.Year & "年" & dtpicker1.Month & "月" & " 费用已经收取,需要打印该月单据吗？ ", vbYesNo + vbInformation) = vbYes Then
    GoTo e:
    Else
     
     Exit Sub
     End If
     End If
     'Text5 = myset1("cllomonth")
     myset1.Close
     
     strsql = "select * from fee where USERID1=" & Trim(txtfields(0).Text)
    Myset.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
    If Myset.EOF Then
        strsql = "insert into fee(USERID1,FEE,) values(" & Trim(txtfields(0).Text) & "," & VAL(txtfields(3)) + VAL(Text5) & ")"
             
      config.cnZdx.Execute strsql
    Else
     strsql = "select * from fee where USERID1=" & Trim(txtfields(0).Text) & " and "
        strsql = "update fee set fee=" & VAL(txtfields(3)) + VAL(Text5) & " where userid1=" & _
                Myset("userid1")
        config.cnZdx.Execute strsql
   
    End If
     Myset.Close
 
 disjieyu VAL(txtfields(0).Text)
 txtfields(2).SetFocus

e:  PRINTDATA
End If
End Sub


Private Sub Form_Load()

   
   
  dtpicker1 = DateSerial(Year(Date), Month(Date), 1)
  DTPicker2 = DateSerial(Year(Date), Month(Date), 1)

      
      
    
    Me.WindowState = 2
End Sub

Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
        Select Case Index
            Case 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)
                 filldate Trim(txtfields(0).Text)   '2004-2-11修改
                 DISINFORM2 Trim(txtfields(0).Text)
                 Text6 = 0
                 Text7 = oper1
                ' Text6 = Format(fillznj(Trim(txtfields(0).Text), VAL(Text3), 0.03), "0.0")
            Case 3
             If chcdata(txtfields(Index)) = False Then
           MsgBox "数据格式不对，请重新输入", vbOKOnly + vbInformation
           Exit Sub
           End If

              Command2.SetFocus
              
            End Select
            End If
End Sub




Sub DISINFORM(str1 As String, str2 As Integer)
Dim rst As New ADODB.Recordset
strsql = "select * from USER1 where louhaoid='" & str1 & "' and userid1=" & str2
 'On Error Resume Next
rst.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
If rst.EOF Or rst.BOF Then
Exit Sub
GoTo e:
Else

txtfields(0).Text = "" & rst("userid1")
txtfields(1).Text = "" & rst("NAME")
txtfields(2).Text = "" & rst("HUHAO")


'frmChildInput.Text2 = "" & rst("watermeter")
End If

e: rst.Close
Set rst = Nothing
End Sub


Sub fillname(str1 As String)
Dim rst As New ADODB.Recordset
strsql = "select * from USER1 where HUHAO='" & str1 & "' "
 'On Error Resume Next
rst.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
If rst.EOF Or rst.BOF Then
MsgBox "该用户不存在，请重新输入正确的楼号", vbOKOnly + vbInformation
Exit Sub
GoTo e:
Else

txtfields(0).Text = "" & rst("userid1")
txtfields(1).Text = "" & rst("NAME")
TXTDATA(15).Text = rst("louhaoid")



'frmChildInput.Text2 = "" & rst("watermeter")
End If

e: rst.Close
Set rst = Nothing



End Sub
Sub DISINFORM1(str1 As String, str2 As Integer)
Dim rst As New ADODB.Recordset
strsql = "select * from datawork where louhaoid='" & str1 & "' and userid1=" & str2
' On Error Resume Next
rst.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
If rst.EOF Or rst.BOF Then
Exit Sub
GoTo e:
Else
dtpicker1 = DateSerial(VAL(rst("clloyear")), VAL(rst("cllomonth")), 1)

End If
e: rst.Close
Set rst = Nothing
End Sub
Sub DISINFORM2(str2 As Integer)
On Error Resume Next
    Dim Myset As New ADODB.Recordset
    Dim MyFeeset As New ADODB.Recordset
    Dim MyFeeSet1 As New ADODB.Recordset
    Dim strsql As String
    Dim sStart As Single, dStart As Date
   
   
   Text1 = "0.0"
   Text2 = "0.0"
   Text3 = "0.0"
   Text4 = "0.0"
   Text5 = "0.0"
   For I = 0 To 14
   TXTDATA(I) = "0.0"
   Next
   
    
    Dim MySet2 As Recordset
 

  strsql = "select * from user1 where userid1=" & str2
                strsql = strsql & " order by userid1"
               Myset.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
                    sTotalFee = 0
                   
          If Myset.EOF = False Then
                    
                    strsql = "select * from datawork where userid1=" & _
                            Myset("userid1") & _
                            " 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=" & _
                            Myset("userid1") & _
                            " and  clloyear=" & _
                            DTPicker2.Year & _
                            " and cllomonth=" & DTPicker2.Month
                    MyFeeSet1.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
                    If MyFeeSet1.EOF Then
                      GoTo g:
                        
                    End If
g:
                    disjieyu str2
                    Text2 = Format((MyFeeset("elcmeter") - MyFeeSet1("elcmeter")) * Myset("elcmeterfee"), "0.00")
                  
                    Text1 = Format((MyFeeset("watermeter") + MyFeeset("watermeter1") - MyFeeSet1("watermeter") - MyFeeSet1("watermeter1")) * Myset("watermeterfee"), "0.00")
                    Text3 = Format((VAL(Text1) + VAL(Text2)), "0.00")
                    
                    Text4 = changedata(-VAL(Text5))
                    If VAL(Text4.Text) < 0 Then
                    Text4.Text = 0
                    End If
                    txtfields(3).Text = Text4.Text
                    TXTDATA(0) = Format(MyFeeSet1("ELCMETER"), "0")
                    TXTDATA(1) = Format(MyFeeSet1("watermeter"), "0")
                    TXTDATA(2) = Format(MyFeeSet1("watermeter1"), "0")
                    TXTDATA(3) = Format(MyFeeset("ELCMETER"), "0")
                    TXTDATA(4) = Format(MyFeeset("watermeter"), "0")
                    TXTDATA(5) = Format(MyFeeset("watermeter1"), "0")
                    TXTDATA(6) = Format(Myset("elcmeterfee"), "0.00")
                    TXTDATA(7) = Format(Myset("watermeterfee"), "0.00")
                    TXTDATA(8) = Format(MyFeeset("elcmeter") - MyFeeSet1("elcmeter"), "0")
                    TXTDATA(9) = Format(MyFeeset("watermeter") - MyFeeSet1("watermeter"), "0")
                    TXTDATA(10) = Format(MyFeeset("watermeter1") - MyFeeSet1("watermeter1"), "0")
                    TXTDATA(11) = Format((MyFeeset("watermeter") - MyFeeSet1("watermeter")) * Myset("watermeterfee"), "0.00")
                    TXTDATA(12) = Format((MyFeeset("watermeter1") - MyFeeSet1("watermeter1")) * Myset("watermeterfee"), "0.00")
                    
                    
                    
                    MyFeeset.Close
                    MyFeeSet1.Close
                   Myset.Close
                End If
                
         disjieyu str2
End Sub
Sub disjieyu(str2 As Integer)
 
   Dim myset1 As New ADODB.Recordset
          strsql = "select * from fee where USERID1=" & str2
       myset1.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
       If myset1.EOF Then
       Text5 = Format(-VAL(Text3) - VAL(Text6), "0.00")
       Else
       
       Text5 = Format(myset1("fee"), "0.00")
    End If

      
     
                   
 myset1.Close
End Sub




Private Sub Frame2_DragDrop(Source As Control, X As Single, y As Single)
txtfields(2).SetFocus
End Sub
Sub PRINTDATA()

 On Error Resume Next
            'On Error GoTo ErrHandler
            dlgCommonDialog1.CancelError = True
            dlgCommonDialog1.ShowPrinter
            If Err.Number = 32755 Then Exit Sub
            Printer.ScaleMode = vbMillimeters           '设置度量单位为毫米
            Printer.ColorMode = vbPRCMColor       '设置打印机为单色打印输出
            'print_H = Printer.Height / 56.7
            'print_W = Printer.Width / 56.7
'            Printer.Orientation = vbPRORPortrait  '设置横向打印
'            Printer.PrintQuality = vbPRPQHigh     '设置打印质量为低分辨率
            
             'Printer.PaperSize = 256
             'Printer.Height = 93
             'Printer.Width = 210
          ' dlgCommonDialog1.Copies = 1
'            dlgCommonDialog.Min = 1
'            dlgCommonDialog.Max = 1
'            dlgCommonDialog.FromPage = 1
'            dlgCommonDialog.ToPage = 1
            'CY = 30
             Screen.MousePointer = vbHourglass
                            Printer.FontSize = 13
                            Printer.CurrentX = 65
                            Printer.CurrentY = 0
                            Printer.Print "天威集团物业公司收费明细单"
                            
                            Printer.Line (25, 5)-(185, 5), 0, B
                            Printer.Line (25, 11)-(185, 11), 0, B
                            Printer.Line (25, 17)-(185, 17), 0, B
                            Printer.Line (25, 23)-(185, 23), 0, B
                            Printer.Line (25, 29)-(185, 29), 0, B
                            Printer.Line (25, 35)-(185, 35), 0, B
                            Printer.Line (25, 41)-(185, 41), 0, B
                            Printer.Line (25, 47)-(185, 47), 0, B
                            Printer.Line (25, 53)-(185, 53), 0, B
                            Printer.Line (25, 59)-(185, 59), 0, B
                            Printer.Line (25, 65)-(185, 65), 0, B
                            Printer.Line (25, 71)-(185, 71), 0, B
                            
                            
                            Printer.Line (25, 5)-(25, 72), 0, B
                            Printer.Line (32, 11)-(32, 65), 0, B
                            Printer.Line (51, 11)-(51, 65), 0, B
                            Printer.Line (78, 11)-(78, 47), 0, B
                            Printer.Line (107, 5)-(107, 47), 0, B
                            Printer.Line (135, 11)-(135, 47), 0, B
                            Printer.Line (145, 5)-(145, 11), 0, B
                            Printer.Line (152, 11)-(152, 65), 0, B
                            Printer.Line (185, 5)-(185, 71), 0, B
                            
                            Printer.FontSize = 11
                            
                            Printer.CurrentX = 26.5
                            Printer.CurrentY = 6
                            Printer.Print "结算日期：" & Format(DateSerial(DTPicker2.Year, DTPicker2.Month, 15), "YYYY.MM") & "-" & _
                            Format(DateSerial(dtpicker1.Year, dtpicker1.Month, 15), "YYYY.MM")
                            Printer.CurrentX = 109
                            Printer.CurrentY = 6
                            Printer.Print "房号：" & Trim(txtfields(2).Text)
                            
                            Printer.CurrentX = 146.5
                            Printer.CurrentY = 6
                            Printer.Print "姓名：" & " " & Trim(txtfields(1).Text)
                  '第二行内容
                            Printer.CurrentX = 33.5
                            Printer.CurrentY = 12
                            Printer.Print "收费项目"
                            
                            Printer.CurrentX = 54
                            Printer.CurrentY = 12
                            Printer.Print "上月表底"
                            
                            Printer.CurrentX = 84
                            Printer.CurrentY = 12