frmrptdemo.frm

how to data report to ado

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "VB Report Designer Demo II: Grouped Report"
   ClientHeight    =   2445
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6360
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   2445
   ScaleWidth      =   6360
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdShow 
      Caption         =   "Sho&w Report"
      Height          =   495
      Left            =   5040
      TabIndex        =   0
      Top             =   240
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Project: VB Data Report Demo II: Grouped Report
' ===============================================
' Created: 05-Jan-2004
' Developer: Brian M. Matumbura
' Purpose: Shows how to use the VB Data Report designer without a Data Environment designer
'          This update shows how do use Shaped Recordset without an underlying data source
'          to generate a hierarchical recordset for use with the report
' Comments & Suggestions: E-mail:- [e-mail], Phone:- [phone]
' Note: You may modify/use this code in your projects without any warranty
' Older Demo: How to use the VB Data Report designer without a Data Environment http://www.freevbcode.com/ShowCode.Asp?ID=6335

' All formating (Dates, Colours, Font Sizes/Attributes) on the report is specified in the Data Report Designer

Option Explicit

Const sTerms = "7 Days:2 Weeks:30 Days:90 Days:120 Days"

Dim rsCustomers As ADODB.Recordset
Dim conSrc As New ADODB.Connection

Private Sub cmdShow_Click()
  With rptDemo
    ' Bind the Recordset to the Report
    Set .DataSource = rsCustomers
    .DataMember = rsCustomers.DataMember
    .Sections("Section4").Controls("lblAddress").Caption = "101 Harare Str." & vbCrLf & "Zimbabwe" & vbCrLf & "Phone: [phone]"
    ' Update the lblRecCount control on the report (Page Footer Section) to show RecordCount
    .Sections("Section5").Controls("lblRecCount").Caption = rsCustomers.RecordCount & " countries listed"
    DoEvents
    .Show
  End With
End Sub

Private Sub Form_Load()
  Dim i As Integer
  
  ' First open a connection to the MSDataShape provider
  conSrc.Open "Provider=MSDataShape;Data Provider=NONE;"
  
  ' Create a recordset to use with the report
  Set rsCustomers = CreateRecords
  
End Sub

Private Function CreateRecords() As ADODB.Recordset
  ' Creates a disconnected hierarchical recordset on the fly
  Dim rsCountries As New ADODB.Recordset
  Dim rsCustomers As ADODB.Recordset
  Dim rsInvoices As ADODB.Recordset
  Dim sShape As String
  Dim i As Integer, j As Integer, k As Integer
  
  sShape = "SHAPE APPEND NEW adInteger AS CountryID, NEW adChar(25) AS Country, NEW adChar(25) AS [Capital City], NEW adInteger AS Population, " & _
           "((SHAPE APPEND NEW adInteger AS CustomerID, NEW adInteger AS CountryID, NEW adChar(20) AS [Customer Name], NEW adChar(80) AS [Address], " & _
           "((SHAPE APPEND NEW adChar(6) AS InvoiceID, NEW adInteger AS CustomerID, NEW adInteger AS [Order Number], NEW adChar(20) AS Terms, NEW adCurrency AS [Amount], NEW adDate AS [Invoice Date]) " & _
           "AS Invoices RELATE CustomerID TO CustomerID)) " & _
           "AS Customers RELATE CountryID TO CountryID)"
  With rsCountries
    .Open sShape, conSrc, adOpenStatic, adLockOptimistic, -1
    
    For i = 0 To 119
      ' Add a new country record
      .AddNew
      Randomize Timer
      !CountryID = i
      !Country = "Country " & i
      ![Capital City] = "City " & i
      !Population = Round(8000000 * Rnd + 3000000)
'      ![ID] = "PID" & Format(i, "00000")
'      ![Description] = "Sample Stock Item " & i
'      Randomize Timer: ![Unit Price] = 101 * Rnd ' Add a random price
'      Randomize Timer: ![Units In Stock] = Int(2000 * Rnd) ' Add a random number of items
'      ![Sub Total] = ![Unit Price] * ![Units In Stock]
      .Update
      Set rsCustomers = .Fields("Customers").Value
      With rsCustomers
        For j = 0 To Int(21 * Rnd)
          .AddNew
          !CustomerID = CLng(CStr(i) & CStr(j))
          !CountryID = i
          ![Customer Name] = "Customer " & !CustomerID
          ![Address] = "Customer " & !CustomerID & "'s Address"
          .Update
          Set rsInvoices = .Fields("Invoices").Value
          With rsInvoices
            For k = 0 To Int(8 * Rnd)
              .AddNew
              !InvoiceID = CLng(CStr(i) & CStr(j) & CStr(k))
              !CustomerID = CLng(CStr(i) & CStr(j))
              ![Order Number] = !InvoiceID + 2
              !Terms = Split(sTerms, ":")(Int(5 * Rnd))
              !Amount = 3000 * Rnd
              ![Invoice Date] = DateAdd("d", -(120 * Rnd), Now)
              .Update
            Next
          End With
        Next
      End With
    Next
  End With
  
  Set CreateRecords = rsCountries
End Function

Private Sub Form_Unload(Cancel As Integer)
  rsCustomers.Close
  Set rsCustomers = Nothing
End Sub