Freigeben über

Cellset (VB-Beispiel)

Gilt für: Access 2013 | Access 2016

In diesem Visual Basic-Projekt werden die Grundlagen veranschaulicht, um mithilfe von ADO MD auf Cubedaten zuzugreifen. Zunächst werden Elementbeschriftungen für Spalten- und Zeilenüberschriften angezeigt und dann formatierte Werte bestimmter Zellen innerhalb der Zellmenge.

 
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

Siehe auch

Support und Feedback

Haben Sie Fragen oder Feedback zu Office VBA oder zu dieser Dokumentation? Unter Office VBA-Support und Feedback finden Sie Hilfestellung zu den Möglichkeiten, wie Sie Support erhalten und Feedback abgeben können.

  • Last updated on