frmreport.vb

对家庭的开支有一个全面的了解和统计

				rst1.Delete()
				rst1.MoveNext()
			Loop 
			
		End If
kk: 
		If txtyear.Text = "" Or cbomonth.Text = "" Then
			MsgBox("请输入开支的年份和选择月份!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "提示")
			Exit Sub
		Else
			'sql = "select * from  payout where " & "pay_date <= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "31" & " # " & " And " & "pay_date >= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "01" & " #"
			
			sql = "select * from  payout where " & "pay_date <= " & "#" & Trim(txtyear.Text) & "-" & Trim(cbomonth.Text) & "-" & Trim(cboday.Text) & " # " & " And " & "pay_date >= " & "#" & Trim(txtyear.Text) & "-" & Trim(cbomonth.Text) & "-" & "01" & "#"
			
			rst = db.OpenRecordset(sql)
			If rst.RecordCount = 0 Then
				MsgBox("没有生成记录,重新设置条件或者数据库中没有记录,请在程序其它查看!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
				Exit Sub
			End If
			rst.MoveFirst()
			Do Until rst.EOF
				
				With rst1
					.AddNew()
					.Fields("pay_order").Value = rst.Fields("pay_order").Value
					.Fields("pay_date").Value = rst.Fields("pay_date").Value
					.Fields("pay_usename").Value = rst.Fields("pay_usename").Value
					.Fields("pay_kind").Value = rst.Fields("pay_kind").Value
					.Fields("pay_money").Value = rst.Fields("pay_money").Value
					.Update()
					rst.MoveNext()
				End With
				
			Loop 
			
			'UPGRADE_WARNING: 未能解析对象 report.Show 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
			report.Show()
		End If
		
		rst.Close()
		'rst1.Close
	End Sub
	
	Public Sub prtmonth()
		
		Dim db As DAO.Database
		Dim rst As DAO.Recordset
		Dim rst1 As DAO.Recordset
		Dim sql As String
		db = DAODBEngine_definst.OpenDatabase("d:\data\payout")
		
		rst1 = db.OpenRecordset("select * from payout_report")
		On Error GoTo kk
		If rst1.RecordCount > 0 Then
			rst1.MoveFirst()
			Do Until rst1.EOF
				rst1.Delete()
				rst1.MoveNext()
			Loop 
			
		End If
kk: 
		If txtyear.Text = "" Or cbomonth.Text = "" Then
			MsgBox("请输入开支的年份和选择月份!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "提示")
			Exit Sub
		Else
			'sql = "select * from  payout where " & "pay_date <= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "31" & " # " & " And " & "pay_date >= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "01" & " #"
			
			sql = "select * from  payout where " & "pay_date <= " & "#" & Trim(txtyear.Text) & "-" & Trim(cbomonth.Text) & "-" & Trim(cboday.Text) & " # " & " And " & "pay_date >= " & "#" & Trim(txtyear.Text) & "-" & Trim(cbomonth.Text) & "-" & "01" & "#"
			
			rst = db.OpenRecordset(sql)
			If rst.RecordCount = 0 Then
				MsgBox("没有生成记录,重新设置条件或者数据库中没有记录,请在程序其它查看!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
				Exit Sub
			End If
			rst.MoveFirst()
			Do Until rst.EOF
				
				With rst1
					.AddNew()
					.Fields("pay_order").Value = rst.Fields("pay_order").Value
					.Fields("pay_date").Value = rst.Fields("pay_date").Value
					.Fields("pay_usename").Value = rst.Fields("pay_usename").Value
					.Fields("pay_kind").Value = rst.Fields("pay_kind").Value
					.Fields("pay_money").Value = rst.Fields("pay_money").Value
					.Update()
					rst.MoveNext()
				End With
				
			Loop 
			
			'report.Show
		End If
		
		rst.Close()
		rst1.Close()
		
	End Sub
	
	
	
	
	Public Sub rptkind()
		Dim report As Object
		Dim db As DAO.Database
		Dim rst As DAO.Recordset
		Dim rst1 As DAO.Recordset
		Dim sql As String
		db = DAODBEngine_definst.OpenDatabase("d:\data\payout")
		'sql = ("select * from payout where  pay_kind ='" & Trim$(dbcbo_kind.Text) & "'")
		
		
		rst1 = db.OpenRecordset("select * from payout_report")
		On Error GoTo kk
		'  If rst1.RecordCount > 0 Then
		rst1.MoveFirst()
		Do Until rst1.EOF
			rst1.Delete()
			rst1.MoveFirst()
		Loop 
		
		'  End If
kk: 
		If dbcbo_kind.Text = "" Then
			MsgBox("请选择种类!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "提示")
			Exit Sub
		End If
		sql = "select * from payout where  pay_kind='" & dbcbo_kind.Text & "'"
		rst = db.OpenRecordset(sql)
		If rst.RecordCount = 0 Then
			MsgBox("没有生成记录,重新设置条件或者数据库中没有记录,请在程序其它查看!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
			Exit Sub
		End If
		rst.MoveFirst()
		
		Do Until rst.EOF
			
			With rst1
				.AddNew()
				.Fields("pay_order").Value = rst.Fields("pay_order").Value
				.Fields("pay_date").Value = rst.Fields("pay_date").Value
				.Fields("pay_usename").Value = rst.Fields("pay_usename").Value
				.Fields("pay_kind").Value = rst.Fields("pay_kind").Value
				.Fields("pay_money").Value = rst.Fields("pay_money").Value
				.Update()
				rst.MoveNext()
			End With
			
		Loop 
		'UPGRADE_WARNING: 未能解析对象 report.Show 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
		report.Show()
		
		
		
		rst.Close()
		'rst1.Close
	End Sub
	Public Sub prtkind()
		Dim db As DAO.Database
		Dim rst As DAO.Recordset
		Dim rst1 As DAO.Recordset
		Dim sql As String
		db = DAODBEngine_definst.OpenDatabase("d:\data\payout")
		sql = ("select * from payout where  pay_kind ='" & Trim(dbcbo_kind.Text) & "'")
		
		
		rst1 = db.OpenRecordset("select * from payout_report")
		On Error GoTo kk
		'  If rst1.RecordCount > 0 Then
		rst1.MoveFirst()
		Do Until rst1.EOF
			rst1.Delete()
			rst1.MoveFirst()
		Loop 
		
		'  End If
kk: 
		If dbcbo_kind.Text = "" Then
			MsgBox("请选择种类!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "提示")
			Exit Sub
		End If
		sql = "select * from payout where  pay_kind='" & dbcbo_kind.Text & "'"
		rst = db.OpenRecordset(sql)
		If rst.RecordCount = 0 Then
			MsgBox("没有生成记录,重新设置条件或者数据库中没有记录,请在程序其它查看!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
			Exit Sub
		End If
		rst.MoveFirst()
		Do Until rst.EOF
			
			With rst1
				.AddNew()
				.Fields("pay_order").Value = rst.Fields("pay_order").Value
				.Fields("pay_date").Value = rst.Fields("pay_date").Value
				.Fields("pay_usename").Value = rst.Fields("pay_usename").Value
				.Fields("pay_kind").Value = rst.Fields("pay_kind").Value
				.Fields("pay_money").Value = rst.Fields("pay_money").Value
				.Update()
				rst.MoveNext()
			End With
			
		Loop 
		'report.Show
		
		
		
		rst.Close()
		rst1.Close()
		
		
	End Sub
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 cbomonth.SelectedIndexChanged。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2075"”
	Private Sub cbomonth_SelectedIndexChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cbomonth.SelectedIndexChanged
		If Trim(txtyear.Text) = "" Then
			MsgBox("年份不能为空!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "年份为空!")
			'ElseIf Trim$(txtyear.Text) < 1904 And Trim$(txtyear.Text) > 2079 Then
			'   MsgBox "年份一定要为数字!且不能小于1904和大于2079", vbOKOnly + vbExclamation, "年份错!"
		End If
		
		If (CDbl(Trim(txtyear.Text)) Mod 4) = 0 And CDbl(Trim(cbomonth.Text)) = 2 Then
			cboday.Text = CStr(29)
		ElseIf CDbl(Trim(cbomonth.Text)) = 2 Then 
			cboday.Text = CStr(28)
		ElseIf (CDbl(Trim(cbomonth.Text)) = 1 Or CDbl(Trim(cbomonth.Text)) = 3 Or CDbl(Trim(cbomonth.Text)) = 5 Or CDbl(Trim(cbomonth.Text)) = 7 Or CDbl(Trim(cbomonth.Text)) = 8 Or CDbl(Trim(cbomonth.Text)) = 10 Or CDbl(Trim(cbomonth.Text)) = 12) Then 
			cboday.Text = CStr(31)
		Else
			cboday.Text = CStr(30)
			
		End If
	End Sub
	
	Private Sub cmdexit_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdexit.Click
		Me.Close()
		frmmain.DefInstance.Show()
	End Sub
	
	Private Sub cmdpreview_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdpreview.Click
		Dim Reportall As Object
		
		
		If optall.Checked = True Then
			'UPGRADE_WARNING: 未能解析对象 Reportall.Show 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
			Reportall.Show()
			
		ElseIf optmonth.Checked = True And txtyear.Text <> "" And cbomonth.Text <> "" Then 
			lblcaption = optmonth.Text
			Call rptmonth()
		ElseIf optkind.Checked = True And dbcbo_kind.Text <> "" Then 
			lblcaption = optkind.Text
			Call rptkind()
		Else
			MsgBox("请选择条件", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
		End If
		
	End Sub
	
	Private Sub cmdprint_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdprint.Click
		Dim report As Object
		Dim cookie As Object
		Dim rptRangeAllPages As Object
		Dim Reportall As Object
		
		If optall.Checked = True Then
			'UPGRADE_WARNING: 未能解析对象 Reportall.PrintReport 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
			'UPGRADE_WARNING: 未能解析对象 cookie 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
			cookie = Reportall.PrintReport(True, rptRangeAllPages)
		Else
			If optmonth.Checked = True Then
				lblcaption = optmonth.Text
				Call prtmonth()
				'UPGRADE_WARNING: 未能解析对象 report.PrintReport 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
				'UPGRADE_WARNING: 未能解析对象 cookie 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
				cookie = report.PrintReport(True, rptRangeAllPages)
			ElseIf optkind.Checked = True Then 
				lblcaption = optkind.Text
				Call prtkind()
				'UPGRADE_WARNING: 未能解析对象 report.PrintReport 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
				'UPGRADE_WARNING: 未能解析对象 cookie 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
				cookie = report.PrintReport(True, rptRangeAllPages)
			End If
		End If
		
	End Sub
	
	'UPGRADE_WARNING: Form 事件 frmreport.Activate 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
	Private Sub frmreport_Activated(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Activated
		Dim db As DAO.Database
		Dim dkrs As DAO.Recordset
		db = DAODBEngine_definst.OpenDatabase("d:\data\payout")
		dkrs = db.OpenRecordset("dkind")
		If Not dkrs.EOF Then
			dkrs.MoveFirst()
			Do Until dkrs.EOF
				dbcbo_kind.Items.Add(Trim(dkrs.Fields("dkind_name").Value))
				dkrs.MoveNext()
			Loop 
		Else
			MsgBox("数据库中没有大类别数据,请在添加!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "设置大类别")
		End If
		dkrs.Close()
	End Sub
	
	Private Sub frmreport_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
		txtyear.Text = CStr(Year(CDate(DateString)))
		txtyear.ReadOnly = True
		'UPGRADE_ISSUE: ComboBox 属性 cbomonth.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
		cbomonth.Locked = True
		'UPGRADE_ISSUE: ComboBox 属性 dbcbo_kind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
		dbcbo_kind.Locked = True
	End Sub
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 optkind.CheckedChanged。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2075"”
	Private Sub optkind_CheckedChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles optkind.CheckedChanged
		If eventSender.Checked Then
			'使别的查询框无效,使与该单选框对应的文本框有效
			If optkind.Checked = True Then
				'UPGRADE_ISSUE: ComboBox 属性 dbcbo_kind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
				dbcbo_kind.Locked = False
				txtyear.ReadOnly = True
				'UPGRADE_ISSUE: ComboBox 属性 cbomonth.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
				cbomonth.Locked = True
			End If
			
		End If
	End Sub
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 optmonth.CheckedChanged。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2075"”
	Private Sub optmonth_CheckedChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles optmonth.CheckedChanged
		If eventSender.Checked Then
			If optmonth.Checked = True Then
				txtyear.ReadOnly = False
				'UPGRADE_ISSUE: ComboBox 属性 cbomonth.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
				cbomonth.Locked = False
				'UPGRADE_ISSUE: ComboBox 属性 dbcbo_kind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
				dbcbo_kind.Locked = True
			End If
		End If
	End Sub
	
	Private Sub txtyear_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles txtyear.KeyPress
		Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
		If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
			KeyAscii = 0
		End If
		If KeyAscii = 0 Then
			eventArgs.Handled = True
		End If
	End Sub
End Class