家庭/个人应用

开发平台：
Visual Basic

Form1.frm：源码内容
							VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "巧制家庭财务报表"
   ClientHeight    =   1725
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   3720
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   1725
   ScaleWidth      =   3720
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command1 
      Caption         =   "显示报表"
      Height          =   495
      Left            =   480
      TabIndex        =   0
      Top             =   240
      Width           =   2775
   End
   Begin VB.Label Label1 
      Caption         =   "程序设计：汤惠莉"
      Height          =   255
      Left            =   1800
      TabIndex        =   1
      Top             =   1320
      Width           =   1935
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定义全局变量
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset
Dim cmd As New ADODB.Command
'Download by http://www.codefans.net
Private Sub Command1_Click()
Dim q As Integer
Dim z As Integer
Dim intCtrl As Integer
  With DataReport1
    Set .DataSource = rs
    .DataMember = ""
    '显示按消费日期分类的消费日期
    With .Sections("section4").Controls
      For intCtrl = 1 To .Count
        If TypeOf .Item(intCtrl) Is RptLabel Then
          .Item(intCtrl).Caption = "消费日期："
        End If
        If TypeOf .Item(intCtrl) Is RptTextBox Then
          .Item(intCtrl).DataMember = ""
          .Item(intCtrl).DataField = "消费日期"
        End If
      Next
    End With
      
    '显示该消费日期中的消费明细
    q = 0
    z = 0
    With .Sections("Section1").Controls
      For intCtrl = 1 To .Count
        If TypeOf .Item(intCtrl) Is RptLabel Then
          .Item(intCtrl).Caption = rs1.Fields(q).Name & "："
          q = q + 1
        End If
        If TypeOf .Item(intCtrl) Is RptTextBox Then
          .Item(intCtrl).DataMember = "Command1"
          .Item(intCtrl).DataField = rs1(z).Name
          z = z + 1
        End If
      Next intCtrl
    End With
    
    '显示按消费日期分类的消费金额的合计
    With .Sections("Section5").Controls
      For intCtrl = 1 To .Count
        If TypeOf .Item(intCtrl) Is RptLabel Then
          .Item(intCtrl).Caption = "合计："
        End If
        If TypeOf .Item(intCtrl) Is RptFunction Then
          .Item(intCtrl).DataMember = "Command1"
          .Item(intCtrl).DataField = rs1(1).Name
        End If
      Next intCtrl
    End With
    .Refresh
    .Show
  End With
End Sub
Private Sub Form_Load()
Dim dbName As String
      
  '连接数据库
  dbName = App.Path + "report.mdb"
  '要使用SHAPE语句，必须指定MSDATASHAPE这个支持者
  cn.Open "Provider=MSDATASHAPE; Data Provider=Microsoft.JET.OLEDB.4.0;" & "Data Source=" & dbName
       
  '按照消费日期这个字段来分类查询该日的消费项目和消费金额
  With cmd
    .ActiveConnection = cn
    .CommandType = adCmdText
    'command1是子查询的别名
    .CommandText = " SHAPE {SELECT 消费项目,消费金额,消费日期 FROM `consume`}  AS Command1 COMPUTE Command1 BY '消费日期'"
    .Execute
  End With
  
  '执行command命令，得到执行结果数据集
  With rs
    .ActiveConnection = cn
    .CursorLocation = adUseClient
    .Open cmd
  End With
  '将分类结果数据集赋予rs1
  Set rs1 = rs(0).Value
End Sub

						