0

我正在尝试创建一个宏来获取一组可变数据，在不同的工作表中创建一个数据透视表，然后从该数据透视表创建一个图表。单步执行时效果很好。但是，当我尝试单击运行按钮或使用宏按钮时，代码将创建一个带有空数据透视表且没有图表的新工作表。

这是代码。

Public Sub UnscheduledGraph()
    Dim wb As Workbook
    Dim ws As Worksheet

    Dim ws
    New As Worksheet

    Set wb = ThisWorkbook

    wb.Sheets.Add After:=wb.Worksheets(wb.Worksheets.Count)
    Set ws = ActiveSheet

    'adds destination for pivot table
    Sheets("DataSheet").Activate
    Range("C5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "m/d/yyyy"
    Range("A4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "DataSheet!R4C1:R24C40", Version:=6).CreatePivotTable TableDestination:=ws.Range("A1"), TableName:="Pivot " & Name, DefaultVersion:=6

    ActiveSheet.Next.Activate 

    With ActiveSheet.PivotTables("Pivot ")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("Pivot ").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("Pivot ").RepeatAllLabels xlRepeatLabels

    With ActiveSheet.PivotTables("Pivot ").PivotFields("Service Area")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Pivot ").PivotFields("Correlation ID")
        .Orientation = xlDataField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Pivot ").PivotFields("Due Date")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Pivot ").PivotFields("Due Date").AutoGroup
    With ActiveSheet.PivotTables("Pivot ").PivotFields("Sum of Correlation ID")
        .Function = xlCount
    End With
    Range("B2").Select
    Selection.Group Start:=True, End:=True, By:=1, Periods:=Array(False, _
        False, False, True, False, False, False)

    'Graph portion

    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Shapes.AddChart2(286, xl3DColumnStacked).Select

    With ActiveChart
        .ClearToMatchStyle
        .ChartStyle = 294
        .SetElement (msoElementDataLabelShow)
        .ChartArea.Font.Color = RGB(255, 255, 255) ' color change
        .ChartArea.Font.Size = 16
    End With

    Stop

End Sub
4

0 回答 0