多機能コール - パブリックサブ

Question

私は自分のパブリックサブを同じデータシートの異なるピボットテーブルを作成する2つの関数に対して呼び出すようにしようとしています。私は両方の関数が独立して動作することを知っていますが、それらを1つのサブに結合すると、 "アプリケーション定義またはオブジェクト定義エラー"が発生します。

以下のマクロは、最初の関数を実行し、目的のピボットテーブルを作成します。 2番目の関数に到達すると停止し、上記のアプリケーションまたはオブジェクト定義のエラーが表示されます。私は独立して各機能を定義しているので、なぜ私が問題を抱えているのか分かりません。

Option Explicit 

Public Sub RunPivots() 
Call BuildPivot1("Travel Payment Data by Employee") 
Call BuildPivot2("Travel Payment Data by Acct Dim") 

End Sub 

Function BuildPivot1(paramSheet As String) 
On Error GoTo ErrHandle 
Dim FinalRow   As Long 
Dim DataSheet   As String 
Dim PvtCache   As PivotCache 
Dim PvtTbl    As PivotTable 
Dim PvtFld    As PivotField 
Dim DataRng    As Range 
Dim TableDest   As Range 
Dim ws     As Worksheet 

For Each ws In ThisWorkbook.Sheets 
    If ws.Name Like "*SQL" & "*" Then 
     '~~> This check is required to ensure that you don't get an error 
     '~~> if there is only one sheet left and it matches the delete criteria 
     If ThisWorkbook.Sheets.Count = 1 Then 
      MsgBox "There is only one sheet left and you cannot delete it" 
     Else 
      '~~> This is required to supress the dialog box which excel shows 
      '~~> When you delete a sheet. Remove it if you want to see the 
      '~~~> Dialog Box 
      Application.DisplayAlerts = False 
      ws.Delete 
      Application.DisplayAlerts = True 
     End If 
    End If 
Next 

FinalRow = Cells(Rows.Count, 1).End(xlUp).Row 

DataSheet = "Export Worksheet" 
' set data range for Pivot Table 
Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 15)) 

' check if worksheet exists 
Dim currws As Worksheet 
For Each currws In ActiveWorkbook.Worksheets 
    If currws.Name = paramSheet Then 
     Set ws = Worksheets(paramSheet) 
     Exit For 
    End If 
Next currws 

' create new worksheet if does not exist 
If ws Is Nothing Then 
    Set ws = Worksheets.Add 
    ws.Name = paramSheet 
End If 

' set range for Pivot table placement 
Set TableDest = Sheets(paramSheet).Cells(1, 1) 

' create pivot cache 
Set PvtCache = ActiveWorkbook.PivotCaches.Create(_ 
      SourceType:=xlDatabase, _ 
      SourceData:=DataRng, _ 
      Version:=xlPivotTableVersion15) 

'check if "PivotTable4" Pivot Table exists 
Dim currpvt As PivotTable 
For Each currpvt In ws.PivotTables 
    If currpvt.Name = "PivotTable4" Then 
     Set PvtTbl = ws.PivotTables("PivotTable4") 
     Exit For 
    End If 
Next currpvt 

' create new pivot table if does not exist 
If PvtTbl Is Nothing Then 
    Set PvtTbl = PvtCache.CreatePivotTable(_ 
     TableDestination:=TableDest, _ 
     TableName:="PivotTable4") 
End If 

With PvtTbl.PivotFields("Security Org") 
    .Orientation = xlRowField 
    .Position = 1 
End With 
With PvtTbl.PivotFields("Fiscal Month") 
    .Orientation = xlRowField 
    .Position = 2 
End With 
With PvtTbl.PivotFields("Budget Org") 
    .Orientation = xlRowField 
    .Position = 3 
End With 
With PvtTbl.PivotFields("Vendor Name") 
    .Orientation = xlRowField 
    .Position = 4 
End With 
With PvtTbl.PivotFields("Fiscal Year") 
    .Orientation = xlRowField 
    .Position = 5 
End With 
With PvtTbl.PivotFields("Fiscal Year") 
    .Orientation = xlColumnField 
    .Position = 1 
End With 

Range("B:E").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.NumberFormat = "$#,##0.00" 
Range("B1").Select 
PvtTbl.CompactLayoutColumnHeader = _ 
    "Fiscal Year" 
Range("A2").Select 
PvtTbl.CompactLayoutRowHeader = _ 
    "Security Org and Vendor" 
Range("G8").Select 

' Add data field if does not exist 
On Error Resume Next 
PvtTbl.AddDataField PvtTbl.PivotFields("Dollar Amount"), "Sum of Dollar Amount", xlSum 
PvtTbl.PivotFields("Budget Org").ShowDetail = _ 
    False 
Exit Function 

ErrHandle: 
MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR" 
Exit Function 
End Function 

Function BuildPivot2(paramSheet As String) 
On Error GoTo ErrHandle 
Dim FinalRow   As Long 
Dim DataSheet   As String 
Dim PvtCache   As PivotCache 
Dim PvtTbl    As PivotTable 
Dim PvtFld    As PivotField 
Dim DataRng    As Range 
Dim TableDest   As Range 
Dim ws     As Worksheet 

For Each ws In ThisWorkbook.Sheets 
    If ws.Name Like "*SQL" & "*" Then 
     '~~> This check is required to ensure that you don't get an error 
     '~~> if there is only one sheet left and it matches the delete criteria 
     If ThisWorkbook.Sheets.Count = 1 Then 
      MsgBox "There is only one sheet left and you cannot delete it" 
     Else 
      '~~> This is required to supress the dialog box which excel shows 
      '~~> When you delete a sheet. Remove it if you want to see the 
      '~~~> Dialog Box 
      Application.DisplayAlerts = False 
      ws.Delete 
      Application.DisplayAlerts = True 
     End If 
    End If 
Next 

FinalRow = Cells(Rows.Count, 1).End(xlUp).Row 

DataSheet = "Export Worksheet" 
' set data range for Pivot Table 
DataSheet = "Export Worksheet" 
' set data range for Pivot Table 
With Sheets(DataSheet) 
    Set DataRng = .Range(Cells(1, 1), .Cells(FinalRow, 15)) 
End With 

' check if worksheet exists 
Dim currws As Worksheet 
For Each currws In ActiveWorkbook.Worksheets 
    If currws.Name = paramSheet Then 
     Set ws = Worksheets(paramSheet) 
     Exit For 
    End If 
Next currws 

' create new worksheet if does not exist 
If ws Is Nothing Then 
    Set ws = Worksheets.Add 
    ws.Name = paramSheet 
End If 

' set range for Pivot table placement 
Set TableDest = Sheets(paramSheet).Cells(1, 1) 

' create pivot cache 
Set PvtCache = ActiveWorkbook.PivotCaches.Create(_ 
      SourceType:=xlDatabase, _ 
      SourceData:=DataRng, _ 
      Version:=xlPivotTableVersion15) 

'check if "PivotTable4" Pivot Table exists 
Dim currpvt As PivotTable 
For Each currpvt In ws.PivotTables 
    If currpvt.Name = "PivotTable4" Then 
     Set PvtTbl = ws.PivotTables("PivotTable4") 
     Exit For 
    End If 
Next currpvt 

' create new pivot table if does not exist 
If PvtTbl Is Nothing Then 
    Set PvtTbl = PvtCache.CreatePivotTable(_ 
     TableDestination:=TableDest, _ 
     TableName:="PivotTable4") 
End If 

With PvtTbl.PivotFields("Fiscal Year") 
    .Orientation = xlColumnField 
    .Position = 1 
End With 
With PvtTbl.PivotFields("Fund") 
    .Orientation = xlRowField 
    .Position = 1 
End With 
With PvtTbl.PivotFields("Budget Org") 
    .Orientation = xlRowField 
    .Position = 2 
End With 
With PvtTbl.PivotFields("Cost Org") 
    .Orientation = xlRowField 
    .Position = 3 
End With 

Range("B:E").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.NumberFormat = "$#,##0.00" 
Range("B1").Select 
PvtTbl.CompactLayoutColumnHeader = _ 
    "Fiscal Year" 
Range("A2").Select 
PvtTbl.CompactLayoutRowHeader = _ 
    "Security Org and Vendor" 
Range("G8").Select 

' Add data field if does not exist 
On Error Resume Next 
PvtTbl.AddDataField PvtTbl.PivotFields("Dollar Amount"), "Sum of Dollar Amount", xlSum 
PvtTbl.PivotFields("Budget Org").ShowDetail = _ 
    False 
Exit Function 

ErrHandle: 
MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR" 
Exit Function 

End Function 

Answer 1

すべてのCells（）およびRange（）呼び出しがワークシートオブジェクトで修飾されていることを確認する必要があります。たとえば：DataSheetワークシートがactivesheetない場合

Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 15)) 

は失敗します。このような

修正：あなたは、任意のデバッグを

With Sheets(DataSheet) 
    Set DataRng = .Range(.Cells(1, 1), .Cells(FinalRow, 15)) 
End With