使用 VBA 创建数据透视图导致运行时 5 错误

Question

我正在尝试通过 VBA 创建数据透视图（因此按钮可以根据表单中的动态值创建饼图）

我的代码是：

 Dim iRow As Long


    '//Find First Empty Row In Database
iRow = Sheets("search results").Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row

    Sheets("Custom Chart").visible = True
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Search Results!A3:AM" & iRow, Version:=xlPivotTableVersion14). _
        CreatePivotTable TableDestination:="Custom Chart!A1", TableName:="PivotTable6" _
        , DefaultVersion:=xlPivotTableVersion14
    Sheets("Custom Chart").Select
    Cells(1, 1).Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Custom Chart!$A$1:$C$18")
    ActiveSheet.Shapes("Chart 1").IncrementLeft 192
    ActiveSheet.Shapes("Chart 1").IncrementTop 15
    ActiveSheet.PivotTables("PivotTable6").AddDataField ActiveSheet.PivotTables( _
        "PivotTable6").PivotFields("Ethnicity Of Child"), "Count of Ethnicity Of Child" _
        , xlCount
    With ActiveSheet.PivotTables("PivotTable6").PivotFields(Me.Dy4.Value)
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveChart.ChartType = xlPie
    ActiveChart.ApplyLayout (6)
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Chart Result"
    ActiveWorkbook.ShowPivotTableFieldList = False

我的代码在这一行失败：

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "Search Results!A3:AM" & iRow, Version:=xlPivotTableVersion14). _
    CreatePivotTable TableDestination:="Custom Chart!A1", TableName:="PivotTable6" _
    , DefaultVersion:=xlPivotTableVersion14

说发生了运行时 5 错误。我能想到的唯一原因是我试图使用单元格引用来定义一个范围，我注意到如果你记录创建一个数据透视图，它使用像Sheet1!R1C1 这样的范围，但我不明白这些引用。

任何帮助将不胜感激。

提前致谢。

Answer 1

我自己解决了这个问题，

以下是从带有变量的表单生成图表的完整代码：

Private Sub Creat_Chart_Click()

Worksheets.Add().Name = "Custom Chart"

If Me.R_End.Value = "" Or _
Me.R_Start.Value = "" Or _
Me.Chart_List.Value = "" Or _
Me.Data_List.Value = "" Or _
Me.Dy2.Value = "" Or _
Me.Dy4.Value = "" Then

MsgBox "Information is missing from the form"

Exit Sub

End If




Dim ws As Worksheet

Set ws = Worksheets("database")

Sheets("Settings").Range("Start_Date").Value = Format(Me.R_Start.Value, "mm/dd/yyyy")
Sheets("Settings").Range("End_Date").Value = Format(Me.R_End.Value, "mm/dd/yyyy")

'Collect Start & End Dates
Dim dStartDate As Long
Dim dEndDate As Long
dStartDate = Sheets("Settings").Range("Start_Date").Value
dEndDate = Sheets("Settings").Range("End_Date").Value

ws.Activate

'On Error GoTo error_Sdate:

    RowNum = Application.WorksheetFunction.Match(dStartDate, Range("B1:B60000"), 0)
    ' MsgBox "Found " & Format(dStartDate, "dd/mm/yyyy") & " at row : " & RowNum

'On Error GoTo error_Edate:

    RowNumEnd = Application.WorksheetFunction.Match(dEndDate, Range("B1:B60000"), 1)
    ' MsgBox "Found " & Format(dEndDate, "dd/mm/yyyy") & " at row : " & RowNumEnd

GoTo J1

error_Sdate:

Dim msg As String

msg = "You entered " & Format(dStartDate, "dd/mm/yyyy") & " as your Start Date, but no referrals were made on that date"
msg = msg & vbCrLf & "Please enter a different date in the Start Date box"
MsgBox msg, , "Start Date Not Found"
Err.Clear
Exit Sub

error_Edate:
msg = "You entered " & Format(dEndDate, "dd/mm/yyyy") & " as your End Date, but no referrals were made on that date"
msg = msg & vbCrLf & "Please enter a different date in the End Date box"
MsgBox msg, , "End Date Not Found"
Err.Clear
Exit Sub


J1:

Dim CR_1 As Integer
Dim CR1 As Integer

'// Get Criteria From Form And Search Database Headers
If Me.Data_List.Value = "Display Variable By Agency Of Referrer" Then

CR1 = 3

End If

If Me.Data_List.Value = "Display Variable By Agency Of Allegee" Then

CR1 = 4

End If



Set ws = Worksheets("database")
Set ps = Worksheets("Search Results")

   ps.Range("A3:AM60000").Clear

'Dim RowNum As Variant
'Dim RowNumEnd As Variant

    For i = RowNum To RowNumEnd
        If ws.Cells(i, CR1).Value = Me.Dy2.Value Then
        ws.Range("A" & i & ":AM" & i).Copy

        ps.Activate
        'find first empty row in database
        emR = ps.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
        ps.Range("A" & emR & ":AM" & emR).PasteSpecial

    End If
    Next i


Dim wksSource As Worksheet
    Dim wksDest As Worksheet
    Dim rngSource As Range
    Dim rngDest As Range
    Dim LastRow As Long
    Dim LastCol As Long

    Set wksSource = Worksheets("Search Results")

    Set wksDest = Worksheets("Custom Chart")

    With wksSource
        LastRow = .Range("A2").End(xlDown).Row
        LastCol = .Range("A2").End(xlToRight).Column
        Set rngSource = .Range("A2", .Cells(LastRow, LastCol))
    End With

    Set rngDest = wksDest.Range("A1")


wksDest.Activate

'    If wksDest.PivotTables.count > 0 Then
'
'
'    wksDest.Range("A:Z").Delete
'
'
'    End If



       ActiveSheet.PivotTableWizard _
        SourceType:=xlDatabase, _
        SourceData:=rngSource, _
        TableDestination:=rngDest, _
        TableName:="Pivotinfo"

    With wksDest.PivotTables("Pivotinfo")
        .PivotFields(Me.Dy4.Value).Orientation = xlRowField
        .PivotFields(Me.Dy4.Value).Orientation = xlDataField
    End With

  Dim CC As Worksheet
  Dim CCR, CCC As Long

 Set CC = Sheets("Custom Chart")


  CCR = CC.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row
  CCC = CC.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Column

            Range("A1").Select
    ActiveWorkbook.Charts.Add
    ActiveChart.ChartType = xlPie
    ActiveChart.ApplyLayout (4)
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.SetElement (msoElementLegendRight)
    ActiveChart.ApplyDataLabels
    ActiveChart.SeriesCollection(1).DataLabels.Select
    Selection.ShowPercentage = True
    Selection.ShowCategoryName = False
    Selection.Separator = "" & Chr(10) & ""
    If CR1 = 3 Then

    ActiveChart.ChartTitle.Characters.Text = Me.Dy4.Value & " Referred By " & Me.Dy2.Value & _
    " Between The Dates " & Me.R_Start.Value & " & " & Me.R_End.Value

    End If

    If CR1 = 4 Then

    ActiveChart.ChartTitle.Characters.Text = Me.Dy4.Value & " Referred By " & Me.Dy2.Value & _
    " Between The Dates " & Me.R_Start.Value & " & " & Me.R_End.Value

    End If




    Application.DisplayAlerts = False
    Worksheets("Custom Chart").Delete
    Application.DisplayAlerts = True

End Sub

我通过删除自定义图表表并重新创建它以摆脱数据透视表来解决此问题，这样我就可以创建一个具有相同名称的新图表。不是最整洁的方法，但它有效