Код VBA работает только тогда, когда я запускаю его шаг за шагом (F8) - PullRequest
0 голосов
/ 13 января 2020

Я пытаюсь создать макрос, чтобы взять переменный набор данных, создать сводную таблицу на другом листе, а затем создать график из этой сводной таблицы. Работает нормально при переходе. Однако, когда я пытаюсь нажать кнопку запуска или использовать кнопку макроса, код создаст новый лист с пустой сводной таблицей и без графика.

Вот код.

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
...