unable to set the function property of the pivot field class

Hello Members

I have been trying to automate the creation of pivot tables using access 2007 vba.

I recorded a macro which gave me a starting point. But got stuck with the error message above beginning with the line

 With objSheetPv.PivotTables("Summary").PivotFields("AmountReceived")
      .Caption = "[Sum of AmountReceived]"
      .Function = xlSum
      End With

Here is the complete code.

What is causing the error?

Private Sub cmdAll_Click()
Dim db As DAO.Database
Dim strSQL As String
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim objSheetPv As Excel.Worksheet
Dim oPt As Excel.PivotTable
Dim PTcache As PivotCache
Dim rst As DAO.Recordset
Dim I As Integer
strSQL = "SELECT qryQuarterlyRF.Description as Vote ," & _
        " qryQuarterlyRF.ActivityName, qryQuarterlyRF.CategoryName," & _
        " qryQuarterlyRF.Aproved_Amount as AmountReceived , " & _
        " qryQuarterlyRF.Q1, qryQuarterlyRF.Q2, qryQuarterlyRF.Q3, qryQuarterlyRF.Q4" & _
        " FROM qryQuarterlyRF;"
On Error GoTo myErr
Set db = CurrentDb()
Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)
If Not rst.EOF Then
Set objApp = New Excel.Application
    objApp.Visible = True
    Set objBook = objApp.Workbooks.Add
    Set objSheet = objBook.Worksheets("Sheet1")
    With objBook
    .Sheets("Sheet2").Name = "SummaryData"
    End With
    Set objSheetPv = objBook.Worksheets("SummaryData")
    objSheet.Select
    objSheet.Range("A2").CopyFromRecordset rst
    For I = 1 To rst.Fields.Count
    objSheet.Cells(1, I).Value = rst.Fields(I - 1).Name
    Next I
    objSheet.UsedRange.EntireColumn.AutoFit
    '''''save the workbook.....   not sure whethe
    With objApp
  
    .Range("D:H").NumberFormat = "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
    End With
   Set PTcache = objBook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        objSheet.UsedRange)
  Set oPt = PTcache.CreatePivotTable _
    (TableDestination:=objSheetPv.Range("A1:H46"), TableName:="Summary")
    With objSheetPv.PivotTables("Summary").PivotFields("ActivityName")
        .Orientation = xlRowField
        .Position = 1
    End With
    With objSheetPv.PivotTables("Summary").PivotFields("CategoryName")
        .Orientation = xlRowField
        .Position = 2
    End With
    With objSheetPv.PivotTables("Summary").PivotFields("Vote")
        .Orientation = xlRowField
        .Position = 3
    End With
     With objSheetPv.PivotTables("Summary").PivotFields("AmountReceived")
      .Caption = "[Sum of AmountReceived]"
      .Function = xlSum
      End With
    With objSheetPv.PivotTables("Summary").PivotFields("[Sum of Q1]")
        .Caption = "Sum of Q1"
        .Function = xlSum
    End With
    With objSheetPv.PivotTables("Summary").PivotFields("[Sum of Q2]")
        .Caption = "Sum of Q2"
        .Function = xlSum
    End With
    With objSheetPv.PivotTables("Summary").PivotFields("[Sum of Q3]")
        .Caption = "Sum of Q3"
        .Function = xlSum
    End With
    With objSheetPv.PivotTables("Summary").PivotFields("[Sum of Q4]")
        .Caption = "Sum of Q4"
        .Function = xlSum
    End With
    With objApp
    .Columns("C:C").ColumnWidth = 15.43
    .Columns("F:F").ColumnWidth = 13.29
    .Columns("E:E").ColumnWidth = 12.86
    .Columns("D:D").ColumnWidth = 14.71
    .Columns("B:B").ColumnWidth = 26.14
    .Columns("B:F").Select
    .NumberFormat = "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders (xlEdgeLeft)
    .LineStyle = xlContinuous
    .Borders (xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .Borders (xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .Borders (xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .Borders (xlInsideVertical)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .Borders (xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders (xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
     .Borders (xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    .Borders (xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    .Borders (xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
   
    .Borders (xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
 
    .Borders (xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
   End With
   
    objBook.ShowPivotTableFieldList = False
    Else
    MsgBox " No Records to Export"
    GoTo myExit
    End If
myExit:
On Error Resume Next
rst.Close
Set db = Nothing
Set objSheet = Nothing
Set objBook = Nothing
Set oPt = Nothing
Set PTcache = Nothing
If Not objApp Is Nothing Then
Set objApp = Nothing
End If
Exit Sub
myErr:
MsgBox " Error" & Err.Description
Resume myExit
End Sub


Ronald
|
Answer
Answer

When using the Function property you need to set the Orientation to xlDataField first to use the xlSum option.

 

Try the following modification:

With objSheetPv.PivotTables("Summary").PivotFields("AmountReceived")

.Orientation = xlDataField
      .Caption = "[Sum of AmountReceived]"
.Function = xlSum
End With

Hope this helps,

Daniel

 

1 person found this reply helpful

Was this reply helpful?

Yes
No

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

 
 

Question Info


Last updated April 12, 2020 Views 4,083 Applies to: