Compartilhar via

Exemplo do Conjunto de Células (VB)

  • Artigo

Aplica-se ao: Access 2013 | Access 2016

Este projeto do Visual Basic demonstra as noções básicas de utilização do ADO MD para acessar dados de cubo. Ele exibe legendas de membro referentes a cabeçalhos de colunas e linhas e, em seguida, exibe valores formatados de células específicas do conjunto de células.

 
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

Confira também

Suporte e comentários

Tem dúvidas ou quer enviar comentários sobre o VBA para Office ou sobre esta documentação? Confira Suporte e comentários sobre o VBA para Office a fim de obter orientação sobre as maneiras pelas quais você pode receber suporte e fornecer comentários.