home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 32 / IOPROG_32.ISO / SOFT / SqlEval7 / MSOLAP / samples / Samples.exe / VbAdoComplex / frmVBADOComplex.frm (.txt) next >
Encoding:
Visual Basic Form  |  1998-10-30  |  5.0 KB  |  103 lines

  1. VERSION 5.00
  2. Begin VB.Form frmVBADOComplex 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   3210
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   2910
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   3210
  10.    ScaleWidth      =   2910
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.CommandButton cmdCellsetToExcel 
  13.       Caption         =   "Cell Set to Excel 8.0"
  14.       Height          =   555
  15.       Left            =   360
  16.       TabIndex        =   0
  17.       Top             =   405
  18.       Width           =   2130
  19.    End
  20. Attribute VB_Name = "frmVBADOComplex"
  21. Attribute VB_GlobalNameSpace = False
  22. Attribute VB_Creatable = False
  23. Attribute VB_PredeclaredId = True
  24. Attribute VB_Exposed = False
  25. Private Sub cmdCellsetToExcel_Click()
  26. Dim cat As New ADOMD.Catalog
  27. Dim cst As New ADOMD.Cellset
  28. Dim axs As ADOMD.Axis
  29. Dim i As Integer
  30. Dim j As Integer
  31. Dim k As Integer
  32. Dim intCellX As Integer
  33. Dim intCellY As Integer
  34. Dim appExcel As New Excel.Application
  35. Dim wbkNew As Excel.Workbook, wksNew As Excel.Worksheet
  36.    On Error GoTo Error_cmdCellsetToExcel_Click
  37. '*--------------------------------------------------------------------------------------------------
  38. '* Set Server to Local Host
  39. '*--------------------------------------------------------------------------------------------------
  40.     strServer = "LOCALHOST"
  41. '*--------------------------------------------------------------------------------------------------
  42. '* Set MDX query string Source
  43. '*--------------------------------------------------------------------------------------------------
  44.     strSource = strSource & "SELECT "
  45.     strSource = strSource & "{[Measures].members} ON COLUMNS,"
  46.     strSource = strSource & "NON EMPTY [Store].[Store City].members ON ROWS"
  47.     strSource = strSource & " FROM Sales"
  48. '*--------------------------------------------------------------------------------------------------
  49. '* Set Active Connection
  50. '*--------------------------------------------------------------------------------------------------
  51.         cat.ActiveConnection = "Data Source=" & strServer & ";Provider=msolap;"
  52. '*--------------------------------------------------------------------------------------------------
  53. '* Set Cell Set source to MDX query string
  54. '*--------------------------------------------------------------------------------------------------
  55.         cst.Source = strSource
  56. '*--------------------------------------------------------------------------------------------------
  57. '* Set Cell Sets active connection to current connection
  58. '*--------------------------------------------------------------------------------------------------
  59.     Set cst.ActiveConnection = cat.ActiveConnection
  60. '*--------------------------------------------------------------------------------------------------
  61. '* Open Cell Set
  62. '*--------------------------------------------------------------------------------------------------
  63.     cst.Open
  64. '*--------------------------------------------------------------------------------------------------
  65. '* Create Workbook and Worksheet Objects
  66. '*--------------------------------------------------------------------------------------------------
  67.     Set wbkNew = appExcel.Workbooks.Add
  68.     Set wksNew = wbkNew.Worksheets.Add
  69.     With wksNew
  70. '*--------------------------------------------------------------------------------------------------
  71. '* Read in All Column Headers
  72. '*--------------------------------------------------------------------------------------------------
  73.         For i = 0 To cst.Axes(0).Positions.Count - 1
  74.             intCellY = i + 2
  75.             .Cells(1, intCellY).Value = cst.Axes(0).Positions(i).Members(0).Caption
  76.         Next
  77. '*--------------------------------------------------------------------------------------------------
  78. '* Read in Row Header
  79. '*--------------------------------------------------------------------------------------------------
  80.         For j = 0 To cst.Axes(1).Positions.Count - 1
  81.             intCellX = j + 2
  82.             .Cells(intCellX, 1).Value = cst.Axes(1).Positions(j).Members(0).Caption
  83. '*--------------------------------------------------------------------------------------------------
  84. '* Read in values for corresponding row header
  85. '*--------------------------------------------------------------------------------------------------
  86.             For k = 0 To cst.Axes(0).Positions.Count - 1
  87.                 intCellY = k + 2
  88.                 .Cells(intCellX, intCellY).Value = cst(k, j).FormattedValue
  89.             Next
  90.         Next
  91.    End With
  92. '*--------------------------------------------------------------------------------------------------
  93. '* Set Excel sheet to Visible
  94. '*--------------------------------------------------------------------------------------------------
  95. appExcel.Visible = True
  96. Set appExcel = Nothing
  97. Exit Sub
  98. Error_cmdCellsetToExcel_Click:
  99.    Beep
  100.    MsgBox "The Following OLE Error has occurred:" & vbCrLf & Err.Description, vbCritical, "OLE Error!"
  101.    Set appExcel = Nothing
  102. End Sub
  103.