Excel 2013 - PowerPivot 内存检查

检查 PowerPivot 内存占用，适用 Excel 2013。

Option ExplicitSub GetMemoryUsage()    Dim wbTarget As Workbook    Dim ws As Worksheet    Dim rs As Object    Dim lRows As Long    Dim lRow As Long    Dim sReportName As String    Dim sQuery As String    sReportName = "Memory_Usage"    'Suppress alerts and screen updates    With Application        .ScreenUpdating = False        .DisplayAlerts = False    End With    'Bind to active workbook    Set wbTarget = ActiveWorkbook    'Check if a worksheet already exists    Err.Clear    On Error Resume Next    Set ws = wbTarget.Worksheets(sReportName)    If Err.Number = 0 Then        'Worksheet found        If MsgBox("A memory usage sheet workbook is already detected, " & _            "do you want to remove the existing one and continue?", vbYesNo) = vbYes Then                ws.Delete        Else            GoTo ExitPoint        End If    End If    On Error GoTo ErrHandler    'Make sure the model is loaded    wbTarget.Model.Initialize    'Send query to the model    sQuery = "SELECT dimension_name, attribute_name, DataType,(dictionary_size/1024) AS dictionary_size " & _        "FROM $system.DISCOVER_STORAGE_TABLE_COLUMNS " & _        "WHERE dictionary_size > 0"    Set rs = CreateObject("ADODB.Recordset")    rs.Open sQuery, wbTarget.Model.DataModelConnection.ModelConnection.ADOConnection    lRow = rs.RecordCount    If lRow > 0 Then        'Add report worksheet        Set ws = wbTarget.Worksheets.Add        With ws            .Name = sReportName            .Range("A1").FormulaR1C1 = "Table"            .Range("B1").FormulaR1C1 = "Column"            .Range("C1").FormulaR1C1 = "DataType"            .Range("D1").FormulaR1C1 = "MemorySize (KB)"            lRows = 2            rs.MoveFirst            Do While Not rs.EOF                'Add the data to the rows                .Range("A" & lRows).FormulaR1C1 = rs("dimension_name")                .Range("B" & lRows).FormulaR1C1 = rs("attribute_name")                .Range("C" & lRows).FormulaR1C1 = rs("DataType")                .Range("D" & lRows).FormulaR1C1 = rs("dictionary_size")                lRows = lRows + 1                rs.movenext            Loop            'Format the Memory Size field            .Columns("D:D").NumberFormat = "#,##0.00"            'Create table            .ListObjects.Add(xlSrcRange, .Range("$A$1:$D$" & lRow + 1), , xlYes).Name = "MemorySizeTable"        End With        'Create PivotTable        wbTarget.PivotCaches.Create(SourceType:=xlDatabase, _            SourceData:="MemorySizeTable", _            Version:=xlPivotTableVersion15).CreatePivotTable _            TableDestination:="Memory_Usage!R2C7", _            TableName:="MemoryTable", _            DefaultVersion:=xlPivotTableVersion15        'Modify the PivotTable        With ws            With .PivotTables("MemoryTable")                With .PivotFields("Table")                    .Orientation = xlRowField                    .Position = 1                    .AutoSort xlDescending, "Sum of MemorySize (KB)"                End With                With .PivotFields("Column")                    .Orientation = xlRowField                    .Position = 2                    .AutoSort xlDescending, "Sum of MemorySize (KB)"                End With                .AddDataField .PivotFields("MemorySize (KB)"), "Sum of MemorySize (KB)", xlSum                .PivotFields("Table").AutoSort xlDescending, "Sum of MemorySize (KB)"                .PivotFields("Column").AutoSort xlDescending, "Sum of MemorySize (KB)"             End With            'Format the Memory Size field in the PivotTable            .Columns("H:H").NumberFormat = "#,##0.00"            'Add conditional formatting            With .Range("H3")                .FormatConditions.AddDatabar                .FormatConditions(.FormatConditions.Count).ShowValue = True                .FormatConditions(.FormatConditions.Count).SetFirstPriority                With .FormatConditions(1)                    .MinPoint.Modify newtype:=xlConditionValueAutomaticMin                    .MaxPoint.Modify newtype:=xlConditionValueAutomaticMax                    With .BarColor                        .Color = 13012579                        .TintAndShade = 0                    End With                    .BarFillType = xlDataBarFillGradient                    .Direction = xlContext                    .NegativeBarFormat.ColorType = xlDataBarColor                    .BarBorder.Type = xlDataBarBorderSolid                    .NegativeBarFormat.BorderColorType = xlDataBarColor                    With .BarBorder.Color                        .Color = 13012579                        .TintAndShade = 0                    End With                    .AxisPosition = xlDataBarAxisAutomatic                    With .AxisColor                        .Color = 0                        .TintAndShade = 0                    End With                    With .NegativeBarFormat.Color                        .Color = 255                        .TintAndShade = 0                    End With                    With .NegativeBarFormat.BorderColor                        .Color = 255                        .TintAndShade = 0                    End With                    .ScopeType = xlSelectionScope                    .ScopeType = xlFieldsScope                End With            End With            With .Range("H4")                .FormatConditions.AddDatabar                .FormatConditions(.FormatConditions.Count).ShowValue = True                .FormatConditions(.FormatConditions.Count).SetFirstPriority                With .FormatConditions(1)                    .MinPoint.Modify newtype:=xlConditionValueAutomaticMin                    .MaxPoint.Modify newtype:=xlConditionValueAutomaticMax                    With .BarColor                        .Color = 15698432                        .TintAndShade = 0                    End With                    .BarFillType = xlDataBarFillGradient                    .Direction = xlContext                    .NegativeBarFormat.ColorType = xlDataBarColor                    .BarBorder.Type = xlDataBarBorderSolid                    .NegativeBarFormat.BorderColorType = _                        xlDataBarColor                    With .BarBorder.Color                        .Color = 15698432                        .TintAndShade = 0                    End With                    .AxisPosition = xlDataBarAxisAutomatic                    With .AxisColor                        .Color = 0                        .TintAndShade = 0                    End With                    With .NegativeBarFormat.Color                        .Color = 255                        .TintAndShade = 0                    End With                    With .NegativeBarFormat.BorderColor                        .Color = 255                        .TintAndShade = 0                    End With                    .ScopeType = xlSelectionScope                    .ScopeType = xlFieldsScope                End With            End With            'Collapse the PivotTable            .PivotTables("MemoryTable").PivotFields("Table").ShowDetail = False            'Set selection to top            .Range("MemorySizeTable[[#Headers],[Table]]").Select        End With    Else        MsgBox "No model available", vbOKOnly    End If    rs.CloseExitPoint:    With Application        .ScreenUpdating = True        .DisplayAlerts = True    End With    Set rs = Nothing    Exit SubErrHandler:    MsgBox "An error occured - " & Err.Description, vbOKOnly    Resume ExitPointEnd Sub