2017-10-03 40 views
0

ピボットテーブルを構築するプロセスを自動化するマクロを作成しました。マクロは正常に動作していますが、エラー1004が表示され続けます(ただし、結果は正常です)。私は以下のコードを提供しています。コードのコメント内のPivotFieldクラスのnameプロパティを設定するとエラー1004が発生する

'PIVOT TABLE 

Dim PSheet As Worksheet 
Dim DSheet As Worksheet 
Dim PRange As Range 
Dim LastRow12 As Long 
Dim LastCol As Long 
Set PSheet = ActiveSheet 
LastRow12 = PSheet.Cells(Rows.Count, 1).End(xlUp).Row 
LastCol = PSheet.Cells(1, Columns.Count).End(xlToLeft).Column 
Set PRange = PSheet.Cells(1, 1).Resize(LastRow12, LastCol) 
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange).CreatePivotTable TableDestination:=PSheet.Cells(2, 16), TableName:="PivotTable1" 
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Destination") 
.Orientation = xlRowField 
.Position = 1 
.Subtotals(1) = True 
.Subtotals(1) = False 
End With 
With ActiveSheet.PivotTables("PivotTable1").PivotFields("End Date") 
.Orientation = xlColumnField 
.Position = 1 
End With 
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Trucks") 
.Orientation = xlDataField 
.Position = 1 
.Function = xlSum 
.NumberFormat = "0.0" 
.Name = "Trucks" 
End With 
+0

どの行でエラーが起こるのでしょうか? – braX

+0

それは行を与えません...それはちょうど良い..すべて実行された後、エラー1004(PivotFieldクラスのnameプロパティを設定するとき)を示すメッセージボックスを与えます。 No line no nothing ... thatsなぜ私はそれを解決することができません –

+1

それはすでにそれの名前は、トラックにその名前を設定しようとしているのですか? – braX

答えて

1

以下のコードを試してみてください、説明:

Option Explicit 

Sub CreatePivot4() 

Dim pvt As PivotTable 
Dim PvtCache As PivotCache 

Dim PSheet As Worksheet 
Dim DSheet As Worksheet 
Dim PRange As Range 
Dim LastRow12 As Long 
Dim LastCol As Long 

Set PSheet = ActiveSheet 
With PSheet 
    LastRow12 = .Cells(.Rows.Count, 1).End(xlUp).Row 
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 
    Set PRange = .Range(.Cells(1, 1), .Cells(LastRow12, LastCol)) 
End With 

' Create Pivot Cache 
Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange.Address(False, False, xlA1, xlExternal)) 

' Set the Pivot Table (already created in previous macro run) 
On Error Resume Next 
Set pvt = PSheet.PivotTables("PivotTable1") 

On Error GoTo 0 
If pvt Is Nothing Then ' <-- pivot table still doesn't exist >> need to create it 

    ' create a new Pivot Table in ActiveSheet sheet, start from Cell A1 
    Set pvt = PSheet.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=PSheet.Cells(2, 16), TableName:="PivotTable1") 

    With pvt 
     With .PivotFields("Destination") 
      .Orientation = xlRowField 
      .Position = 1 
      .Subtotals(1) = True 
      .Subtotals(1) = False 
     End With 
     With .PivotFields("End Date") 
      .Orientation = xlColumnField 
      .Position = 1 
     End With 
     With .PivotFields("Trucks") 
      .Orientation = xlDataField 
      .Position = 1 
      .Function = xlSum 
      .NumberFormat = "0.0" 
      '.Name = "Trucks" ' * Why do you need to rename it ? 
     End With 
    End With 
Else 
    ' just refresh the Pivot table, with updated Pivot Cache 
    pvt.ChangePivotCache PvtCache 
    pvt.RefreshTable 
End If 

End Sub 
関連する問題