LinkBack URL
About LinkBacksHello,
I've got a problem with some code.
I'm getting a "Unable to get the PivotFields property of the PivotTable
Class" error
on the following line/s:
With ActiveSheet.PivotTables("PT_ADO").PivotFields("SALARY RATE")
.Orientation = xlRowField
.Position = 13
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
The error seems to have something to do with the data type of the
column.
The column "SALARY RATE" is data type Numeric (5,2)
If I convert it to Character the code works but my column is now
formatted as text, and I can't seem to reformat it back to numeric.
Here's the before and after of the column.
Before - Doesn't work
stSQL = stSQL & "A.SESRAT AS ""SALARY RATE"", "
After - Does work
stSQL = stSQL & "CHAR(A.SESRAT) AS ""SALARY RATE"", "
Does anyone have any ideas?
TIA,
Karl
------------------Begin Code------------------
Option Explicit
Public cnt As ADODB.Connection
Public rst As ADODB.Recordset
Public stCon As String
Public stSQL As String
Public wbBook As Workbook
Public wsSheet As Worksheet
Public ptCache As PivotCache
Public ptTable As PivotTable
Public xlCalc As XlCalculation
Sub CommandButton1_Click()
Create_PivotTable_ADO_Source
FormatPT
Unload Me
End Sub
Sub Create_PivotTable_ADO_Source()
Dim rnStart As Range
stCon = "provider=IBMDA400;data source=NN.NNN.N.N;USER ID=" &
txtUID.Value & ";PASSWORD=" & txtPWD.Value & ";"
stSQL = ""
stSQL = "SELECT A.SECONO AS ""COMPANY NUMBER"", "
stSQL = stSQL & "A.SEEMNO AS ""EMPLOYEE NUMBER"", "
stSQL = stSQL & "A.SEEMNM AS ""EMPLOYEE NAME"", "
stSQL = stSQL & "A.SELVL1 AS ""UNIT/BRANCH NUMBER"", "
stSQL = stSQL & "C1L1NM AS ""UNIT/BRANCH NAME"", "
stSQL = stSQL & "A.SELVL2 AS ""DIVISION NUMBER"", "
stSQL = stSQL & "C2L2NM AS ""DIVISION NAME"", "
stSQL = stSQL & "A.SEJOBT AS ""JOB TITLE"", "
stSQL = stSQL & "A.SEJCLS AS ""JOB CLASS"", "
stSQL = stSQL & "P4JCLD AS ""JOB CLASS NAME"", "
stSQL = stSQL & "B.SESUPR AS ""SUPERVISOR NAME"", "
stSQL = stSQL &
"(SUBSTR(DIGITS(A.SEHDMD),1,2)||'/'||SUBSTR(DIGITS(A.SEHDMD),3,2)||'/'||SUBSTR(DIGITS(A.SEHDYR),1,4))
AS ""HIRE DATE"", "
stSQL = stSQL &
"(SUBSTR(DIGITS(A.SETDMD),1,2)||'/'||SUBSTR(DIGITS(A.SETDMD),3,2)||'/'||SUBSTR(DIGITS(A.SETDYR),1,4))
AS ""TERM DATE"", "
stSQL = stSQL & "A.SESRAT AS ""SALARY RATE"", "
stSQL = stSQL & "A.SEHRAT AS ""HOURLY RATE"", "
'stSQL = stSQL & "CHAR(A.SESRAT) AS ""SALARY RATE"", "
'stSQL = stSQL & "CHAR(A.SEHRAT) AS ""HOURLY RATE"", "
stSQL = stSQL & "A.SEWRKS AS ""WORK STATUS"", "
stSQL = stSQL & "P0ASTD AS ""WORK STATUS DESC"", "
stSQL = stSQL & "1 AS ""COUNT"" "
stSQL = stSQL & "FROM "
stSQL = stSQL & "LIBRARY.SEFILEL A "
stSQL = stSQL & "INNER JOIN "
stSQL = stSQL & "LIBRARY.C1FILEL "
stSQL = stSQL & "ON "
stSQL = stSQL & "A.SELVL1 = C1LVL1 "
stSQL = stSQL & "INNER JOIN "
stSQL = stSQL & "LIBRARY.C2FILEL "
stSQL = stSQL & "ON "
stSQL = stSQL & "A.SELVL2 = C2LVL2 "
stSQL = stSQL & "INNER JOIN "
stSQL = stSQL & "LIBRARY.P4JCLSL "
stSQL = stSQL & "ON "
stSQL = stSQL & "A.SEJCLS = P4JCLS "
stSQL = stSQL & "INNER JOIN "
stSQL = stSQL & "LIBRARY.SVFILEL B "
stSQL = stSQL & "ON "
stSQL = stSQL & "A.SECONO=B.SECONO AND "
stSQL = stSQL & "A.SESUP#=B.SESUP# "
stSQL = stSQL & "INNER JOIN "
stSQL = stSQL & "LIBRARY.P0ASTSL "
stSQL = stSQL & "ON "
stSQL = stSQL & "A.SEWRKS = P0ASTC "
stSQL = stSQL & "WHERE "
stSQL = stSQL & "((A.SEHDYR * 10000) + A.SEHDMD) BETWEEN " &
FromTD.Value & " AND " & ToTD.Value & " AND "
stSQL = stSQL & "SESTAT = 'A' "
stSQL = stSQL & "ORDER BY A.SECONO, A.SELVL1, A.SELVL2 "
'Delete "New Hires" if it exists
On Error Resume Next
Application.DisplayAlerts = False
Sheets("New Hires").Delete
On Error GoTo 0
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets.Add
With wsSheet
Set rnStart = .Range("A1")
End With
wsSheet.Name = "New Hires"
ADO_Call stCon, stSQL
Set ptCache = wbBook.PivotCaches.Add(SourceType:=xlExternal)
'Add the Recordset as the source to the pivotcache.
With ptCache
'Set .OptimizeCache = True
Set .Recordset = rst
End With
'Create the pivottable
Set ptTable = ptCache.CreatePivotTable(TableDestination:=rnStart, _
TableName:="PT_ADO")
'Dim i As Integer
'With ActiveSheet.PivotTables("PT_ADO")
'For i = 1 To .PivotFields.Count
' MsgBox .PivotFields(i).Name
'Next
'End With
'Set up the pivottable.
With ActiveSheet.PivotTables("PT_ADO").PivotFields("COMPANY
NUMBER")
.Orientation = xlPageField
.Position = 1
.CurrentPage = "ALL"
End With
'With ActiveSheet.PivotTables("PT_ADO").PivotFields(Sheets("New
Hires").Range("A4").Text)
With ActiveSheet.PivotTables("PT_ADO").PivotFields("EMPLOYEE
NUMBER")
.Orientation = xlRowField
.Position = 1
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("EMPLOYEE NAME")
.Orientation = xlRowField
.Position = 2
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("UNIT/BRANCH
NUMBER")
.Orientation = xlRowField
.Position = 3
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("UNIT/BRANCH
NAME")
.Orientation = xlRowField
.Position = 4
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("DIVISION
NUMBER")
.Orientation = xlRowField
.Position = 5
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("DIVISION NAME")
.Orientation = xlRowField
.Position = 6
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("JOB TITLE")
.Orientation = xlRowField
.Position = 7
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("JOB CLASS")
.Orientation = xlRowField
.Position = 8
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("JOB CLASS
NAME")
.Orientation = xlRowField
.Position = 9
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("SUPERVISOR
NAME")
.Orientation = xlRowField
.Position = 10
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("HIRE DATE")
.Orientation = xlRowField
.Position = 11
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("TERM DATE")
.Orientation = xlRowField
.Position = 12
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("SALARY RATE")
.Orientation = xlRowField
.Position = 13
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("HOURLY RATE")
.Orientation = xlRowField
.Position = 14
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("WORK STATUS")
.Orientation = xlRowField
.Position = 15
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("WORK STATUS
DESC")
.Orientation = xlRowField
.Position = 16
.Subtotals = Array(False, False, False, False, False, False,
False, False, False, False, False, False)
End With
With ActiveSheet.PivotTables("PT_ADO").PivotFields("COUNT")
.Orientation = xlDataField
.Position = 1
End With
With ActiveSheet.Columns("A:Q")
.AutoFit
End With
ActiveWorkbook.ShowPivotTableFieldList = False
'Release the Recordset from the memory.
If CBool(rst.State And adStateOpen) Then rst.Close
Set rst = Nothing
End Sub
Private Function ADO_Call(stCon As String, stSQL As String) As
ADODB.Recordset
Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
'Temporarily change some settings.
With Application
xlCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
'Open the connection and fill the Recordset.
With cnt
.CursorLocation = adUseClient
.Open stCon
Set rst = .Execute(stSQL)
End With
'Disconnect the Recordset.
Set rst.ActiveConnection = Nothing
If CBool(cnt.State And adStateOpen) Then cnt.Close
Set cnt = Nothing
'Restore the settings.
With Application
.Calculation = xlCalc
.EnableEvents = True
.ScreenUpdating = True
End With
End Function
Sub FormatPT()
Sheets("New Hires").Range("A5").Select
ActiveWindow.FreezePanes = True
With Sheets("New Hires").PageSetup
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = ""
End With
Sheets("New Hires").PageSetup.PrintArea = ""
With Sheets("New Hires").PageSetup
.LeftHeader = ""
.CenterHeader = "&""Arial,Bold""&11New Hire Report for Employee's
hired between " & Mid(FromTD.Value, 5, 2) & "/" & Right(FromTD.Value,
2) & "/" & Left(FromTD.Value, 4) & " and " & Mid(ToTD.Value, 5, 2) &
"/" & Right(ToTD.Value, 2) & "/" & Left(ToTD.Value, 4) & ""
.RightHeader = "&""Arial,Bold""&11&D"
.LeftFooter = ""
.CenterFooter = "&""Arial,Bold""&11Page &P of &N"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLegal
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
End Sub
------------------End Code------------------
Register To Reply
Bookmarks