創建透視圖表使用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 

我解決這個問題得到了通過刪除自定義圖表工作表，並重新創建它來擺脫數據透視表，這樣我就可以創建一個具有相同名稱的新數據表。不是最簡潔的方法，但它起作用