Compartir a través de

Ejemplo de Cellset (VB)

  • Artículo

Se aplica a: Access 2013 | Access 2016

Este proyecto de Visual Basic muestra los conceptos básicos del uso de ADO MD para tener acceso a datos de un cubo. Muestra títulos de elementos para encabezados de columna y de fila y, a continuación, presenta valores con formato de celdas específicas en el conjunto de celdas.

 
Sub cmdCellSettoDebugWindow_Click() 
 On Error GoTo Error_cmdCellSettoDebugWindow_Click 
 
 Dim cat As New ADOMD.Catalog 
 Dim cst As New ADOMD.CellSet 
 Dim strServer As String 
 Dim strSource As String 
 Dim strColumnHeader As String 
 Dim strRowText As String 
 Dim i As Integer 
 Dim j As Integer 
 Dim k As Integer 
 
 Screen.MousePointer = vbHourglass 
 
 '*----------------------------------------------------------------------- 
 '* Set Server to Local Host 
 '*----------------------------------------------------------------------- 
 strServer = "localhost" 
 
 '*----------------------------------------------------------------------- 
 '* Set MDX query string Source 
 '*----------------------------------------------------------------------- 
 strSource = "SELECT {[Measures].members} ON COLUMNS," & _ 
 "NON EMPTY [Store].[Store City].members ON ROWS FROM Sales" 
 
 '*----------------------------------------------------------------------- 
 '* Set Active Connection 
 '*----------------------------------------------------------------------- 
 cat.ActiveConnection = "Data Source=" & strServer & ";Provider=msolap;" 
 
 '*----------------------------------------------------------------------- 
 '* Set Cell Set source to MDX query string 
 '*----------------------------------------------------------------------- 
 cst.Source = strSource 
 
 '*----------------------------------------------------------------------- 
 '* Set Cell Sets active connection to current connection 
 '*----------------------------------------------------------------------- 
 Set cst.ActiveConnection = cat.ActiveConnection 
 
 '*----------------------------------------------------------------------- 
 '* Open Cell Set 
 '*----------------------------------------------------------------------- 
 cst.Open 
 
 '*----------------------------------------------------------------------- 
 '* Allow space for Row Header Text 
 '*----------------------------------------------------------------------- 
 strColumnHeader = vbTab & vbTab & vbTab & vbTab & vbTab & vbTab 
 
 '*----------------------------------------------------------------------- 
 '* Loop through Column Headers 
 '*----------------------------------------------------------------------- 
 For i = 0 To cst.Axes(0).Positions.Count - 1 
 strColumnHeader = strColumnHeader & _ 
 cst.Axes(0).Positions(i).Members(0).Caption & vbTab & _ 
 vbTab & vbTab & vbTab 
 Next 
 Debug.Print vbTab & strColumnHeader & vbCrLf 
 
 '*----------------------------------------------------------------------- 
 '* Loop through Row Headers and Provide data for each row 
 '*----------------------------------------------------------------------- 
 strRowText = "" 
 For j = 0 To cst.Axes(1).Positions.Count - 1 
 strRowText = strRowText & _ 
 cst.Axes(1).Positions(j).Members(0).Caption & vbTab & _ 
 vbTab & vbTab & vbTab 
 For k = 0 To cst.Axes(0).Positions.Count - 1 
 strRowText = strRowText & cst(k, j).FormattedValue & _ 
 vbTab & vbTab & vbTab & vbTab 
 Next 
 Debug.Print strRowText & vbCrLf 
 strRowText = "" 
 Next 
 
 Screen.MousePointer = vbDefault 
 
 Exit Sub 
 
Error_cmdCellSettoDebugWindow_Click: 
 Beep 
 Screen.MousePointer = vbDefault 
 Set cat = Nothing 
 Set cst = Nothing 
 MsgBox "The Following Error has occurred:" & vbCrLf & _ 
 Err.Description, vbCritical, " Error!" 
 Exit Sub 
End Sub

Vea también

Soporte técnico y comentarios

¿Tiene preguntas o comentarios sobre VBA para Office o esta documentación? Vea Soporte técnico y comentarios sobre VBA para Office para obtener ayuda sobre las formas en las que puede recibir soporte técnico y enviar comentarios.