frmfeechange1.frm

水电费收费管理系统

    Dim MYSET As New ADODB.Recordset
    Dim MyFeeset As New ADODB.Recordset
    Dim MyFeeSet1 As New ADODB.Recordset
     Dim myset1  As New ADODB.Recordset
    Dim strsql As String
    Dim sStart As Single, dStart As Date
    
    Dim MyChangeSet As Recordset
    Dim sPowerValue As Single, sTotalValue As Single, sTotalFee As Single, stotalfee1 As Single
   
   
    Dim sTotalValue_D As Single
    Dim sTotalFee_D As Single
    Dim sTotalValue_Water As Single
    Dim sTotalFee_Water As Single
   
    Select Case Index
        Case 0  '确定
            'lblTitle.Caption = cmbElement.Text & " " & dtpStart.Year & "年" & dtpStart.Month & "月 水电费明细"
            Dim MYSET2 As New ADODB.Recordset
Dim myset3 As New ADODB.Recordset
Dim strsql1 As String
  If cmbElement.Text = " " Then
              
strsql1 = "select * from user1 "
Else
strsql1 = "select * from user1 where LOUHAOID='" & cmbElement.Text & "'"
End If
myset3.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
If myset3.EOF Then
Exit Sub
End If

  strsql1 = "select * from datawork  where clloyear=" & _
                            Year(Now) & " and cllomonth=" & _
                            Month(Now)
    MYSET2.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
    If MYSET2.EOF Then
    MsgBox "本月表数据不存在，请运行表底输入程序输入用户本月表底", vbOKOnly + vbInformation
    Exit Sub
    End If
    
    If MYSET2.RecordCount < myset3.RecordCount Then
     MsgBox "该月表计数据共" & myset3.RecordCount & "户,请确定表计输入已全部完成，再执行月费用计算程序", vbOKOnly + vbInformation
    Exit Sub
    End If
    MYSET2.Close
    myset3.Close
            With mfgFee
                .Clear
                .FormatString = "< 楼     号 |<房   主|>合计金额|>余   额|"
                            
              
                .Rows = 1
               
                .Cols = 4
              If cmbElement.Text = " " Then
              
                strsql = "select * from user1 "
                Else
                 strsql = "select * from user1 where LOUHAOID='" & cmbElement.Text & "'"
                End If
                strsql = strsql & " order by userid1"
               MYSET.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
                Do Until MYSET.EOF
                    .Rows = .Rows + 1
                    .row = .Rows - 1
                    sTotalFee = 0
                   
                    
                    
                    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:                  MyFeeSet1.Close
          If DTPicker2.Year < 2003 Then
                GoTo g:
                End If
                    strsql = "select * from datawork where userid1=" & _
                            MYSET("userid1") & _
                            " and  clloyear=" & _
                            IIf(DTPicker2.Month = 1, DTPicker2.Year - 1, DTPicker2.Year) & _
                            " and cllomonth=" & IIf(DTPicker2.Month = 1, 12, DTPicker2.Month - 1)
                    MyFeeSet1.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
                    If MyFeeSet1.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
g:                    sTotalFee = Format((MyFeeset("watermeter") - MyFeeSet1("watermeter") + MyFeeset("watermeter1") - MyFeeSet1("watermeter1")) * MYSET("watermeterfee") + _
                     (MyFeeset("elcmeter") - MyFeeSet1("elcmeter")) * MYSET("elcmeterfee"), "0.00")
                     
                     strsql = "select * from fee where userid1=" & MYSET("userid1")
                    myset1.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
                    If myset1.EOF Then
                     strsql = "insert into fee values(" & MYSET("userid1") & "," & -sTotalFee & "," & DTPicker1.Year & "," & DTPicker1.Month & ",'" & MYSET("louhaoid") & _
                     "'," & MYSET("elcmeterfee") & "," & MYSET("watermeterfee") & ",'" & MYSET("NAME") & "','" & MYSET("HUHAO") & "')"
                    stotalfee1 = -sTotalFee
                   config.cnZdx.Execute strsql
                    Else
                   If DTPicker1.Year = myset1("clloyear") And DTPicker1.Month = myset1("cllomonth") Then
                    MsgBox "本月费用已转换", vbOKOnly + vbInformation
                  
                   Exit Sub
                   Else
                   
                   
                  strsql = "update fee set fee=" & myset1("fee") - sTotalFee & ",clloyear =" & _
                  DTPicker1.Year & ",cllomonth=" & DTPicker1.Month & " where userid1=" & _
                 MYSET("userid1")
                 config.cnZdx.Execute strsql
                 stotalfee1 = myset1("fee") - sTotalFee
                  End If
                   End If
                     .Col = 0
                    .Text = MYSET("huhao")
                    .Col = 1
                    .Text = MYSET("name")
                    
                     .Col = 2
                     .Text = sTotalFee
                    .Col = 3
                    
                   
                 .Text = stotalfee1
                 
                    
                    MyFeeset.Close
                    MyFeeSet1.Close
                     myset1.Close
                    MYSET.MoveNext
                    
                Loop
'                For i = 0 To 9
'                    .ColWidth(i) = 1000
'                Next
                  MYSET.Close
                .Rows = .Rows + 1
                .row = .Rows - 1
                .Col = 0: .Text = "合计"
                .Col = 4: .Text = Format(sTotalValue_D, , "0.00")
                .Col = 6: .Text = Format(sTotalFee_D, "0.00")
                .Col = 9: .Text = Format(sTotalValue_Water, "0.00")
                .Col = 11: .Text = Format(sTotalFee_Water, "0.00")
                .Col = 12: .Text = Format(sTotalFee_D + sTotalFee_Water, "0.00")
               
               ' .ColWidth(3) = 850
                
              
            End With
       
        Case 2  '退出
            Unload Me
     
    End Select
    Exit Sub
ErrHandler:
    MsgBox "error"
End Sub



Private Sub Command3_Click()

End Sub


Private Sub Form_Load()
 Me.Show
  Fillcomb cmbElement, "select * from louhao order by bmid", "bmname"
    cmbElement.ListIndex = -1
    DTPicker1 = DateSerial(Year(Now), Month(Now), 1)
     DTPicker2 = DateSerial(Year(Now), Month(Now), 1)
    lblTitle.Caption = ""
    Command1(0).SetFocus
    mfgFee.Clear
    'AddCombo1 cboPrecinct, "select * from bmPowerElement where type='所'"
   
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    With mfgFee
        .Top = 1800
        .Left = 60
        .Height = Me.Height - 2800
        .Width = Me.Width - 260
        lblTitle.Left = .Left
        
    End With
    Command1(0).Top = 1900 + mfgFee.Height
    Command1(1).Top = Command1(0).Top
    Command1(2).Top = Command1(0).Top
    Command1(3).Top = Command1(0).Top
End Sub


'打印Grid对象的子程序,只要给出表格的名称和起始的X,Y坐标,即可完成操作
Sub Print_Grid(gd As Control, CY0 As Long)
    On Error Resume Next
    Dim I As Integer, j As Integer
    Dim CX0 As Single
    
    'Printer.ScaleMode = 3
    Printer.FontSize = 10
    With gd
        For I = 0 To .Rows - 1
            .row = I
            CX0 = 22
            For j = 0 To .Cols
                .Col = j
                '打印表格线
                Printer.Line (CX0, CY0)-(CX0 + .ColWidth(j) / 56.7 + 3, _
                        CY0 + TextHeight("d") / 56.7 * 2), 0, B
                '设置表格内文字的位置
                If .row = 0 Then
                    Printer.CurrentX = CX0 + (.ColWidth(j) / 56.7 - TextWidth(.Text) / 56.7) / 2 + 1.5
                ElseIf .ColAlignment(j) = 7 Then
                    Printer.CurrentX = CX0 + (.ColWidth(j) / 56.7 + 3 - TextWidth(.Text) / 56.7) - 3
                Else
                    Printer.CurrentX = CX0 + 1.5
                End If
                Printer.CurrentY = CY0 + 1.5
                '打印文字
                Printer.Print .Text
                '计算下一列表格的起始横坐标位置
                CX0 = CX0 + .ColWidth(j) / 56.7 + 3
            Next j
            '计算下一行表格的起始纵坐标位置
            If CY0 >= print_H - 30 Then
                Printer.NewPage
                CY0 = 30
            Else
                CY0 = CY0 + TextHeight("d") / 56.7 * 2
            End If
        Next I
    End With
End Sub

Function fPrintText(sTitle As String, CX As Single, CY As Single, _
                iFontSize As Integer, bBold As Boolean)
    P.Font.Bold = bBold
    P.FontSize = iFontSize
    P.CurrentX = CX
    P.CurrentY = CY
    P.Print sTitle
End Function