frmfeechange.frm

水电费收费管理系统

Private Sub Command1_Click(Index 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 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 & "月 水电费明细"
            
            With mfgFee
                .Clear
                .FormatString = "< 楼     号 |<房   主|>合计金额|>余   额|"
                            
              
                .Rows = 1
               
                .Cols = 4
             
                strsql = "select * from user1 "
               
                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
  
    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